VistA-FOIAVistA/r/AUTOMATED_INFO_COLLECTION_S.../IBDFC1.m

101 lines
2.8 KiB
Mathematica

IBDFC1 ;ALB/CJM - ENCOUNTER FORM - CONVERTED FORMS LIST ;MAR 3, 1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
LIST ;
N IBCLINIC,IBTKFORM,IBTKBLK,IBAPI
S (IBTKFORM,IBTKBLK,IBCLINIC)=""
S IBAPI("INDEX")="D IDXFORMS^IBDFC1"
S IBAPI("SELECT")="D SELECT^IBDFC1"
D EN^VALM("IBDFC CONVERSION LOG")
D VALMSG^IBDFC
S VALMBCK="R"
Q
;
ONENTRY ;
D IDXFORMS
Q
ONEXIT ;
K ^TMP("IBDF",$J,"CONVERTED FORMS")
Q
;
HDR ;
S VALMHDR(1)=" *** LOG OF FORMS THAT HAVE BEEN CONVERTED FOR SCANNING ***"
Q
;
IDXFORMS ;build a list of converted forms
N IEN
K @VALMAR
S VALMCNT=0
S IEN=0 F S IEN=$O(^IBD(359,IEN)) Q:'IEN D ENTRY
Q
;
ENTRY ;adds an entry to the array
N NODE,FORM,WARNING,REPLACED
S NODE=$G(^IBD(359,IEN,0))
Q:NODE=""
S FORM=+NODE
S VALMCNT=VALMCNT+1
S WARNING=$S($O(^IBD(359,IEN,1,0)):"YES",1:"NO ")
S REPLACED=$S($P(NODE,"^",5):"YES",1:"NO ")
S @VALMAR@(VALMCNT,0)=$J(VALMCNT,3)_" "_$$LJ^XLFSTR($P(NODE,"^",3),30)_" "_$$LJ^XLFSTR($$FMTE^XLFDT($P(NODE,"^",4),"2D"),10)_" "_$$CJ^XLFSTR(WARNING,8)_" "_$$CJ^XLFSTR(REPLACED,18)
D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
I WARNING="YES" D CNTRL^VALM10(VALMCNT,52,3,IOINHI,IOINORM,0)
I REPLACED="NO " D CNTRL^VALM10(VALMCNT,69,2,IOINHI,IOINORM,0)
S @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM_"^"_IEN
Q
;
SELECT ;returns IBFORM,IBCNVRT
N SEL
K DIR
D EN^VALM2(XQORNOD(0),"S")
S SEL=$O(VALMY(""))
S IBFORM=$S('SEL:"",1:+$G(@VALMAR@("IDX",SEL,SEL)))
S IBCNVRT=$S('SEL:"",1:$P($G(@VALMAR@("IDX",SEL,SEL)),"^",2))
Q
;
WARNINGS ;displays conversion warnings
N IBFORM,IBARY,IBHDRRTN,IBCNVRT
D SELECT
Q:'IBCNVRT
S IBARY="^IBD(359,"_IBCNVRT_",1)"
S IBHDRRTN="D WARNHDR^IBDFC1"
D EN^VALM("IBDE TEXT DISPLAY")
S VALMBCK="R"
Q
WARNHDR ;
S VALMHDR(1)=" *** Conversion Warnings For "_$P($G(^IBD(359,IBCNVRT,0)),"^",3)_" ***"
Q
;
DELFORM ;used to delete forms from other places than the clinic setup screen
N CLINIC,IBFORM,IBCNVRT,BLOCK,NOCANDO,SETUP,ARY
S NOCANDO=0,ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"
K @ARY
S VALMBCK="R"
I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
Q:'IBFORM
D CLINICS^IBDFU4(IBFORM,ARY)
I $G(@ARY@(0)) D
.W !,"Cannot be deleted, the form is in use!"
.D LIST^IBDFU4(ARY,IOSL)
I '$G(@ARY@(0)) D
.D DELETE^IBDFU2C(.IBFORM,357,1)
.I '$G(IBFORM) D
..K DIK,DA S DIK="^IBD(359,",DA=IBCNVRT D ^DIK K DIK,DA
..D IDXFORMS
K @ARY
Q
;
PURGE ;purge the conversion log
N SDATE,IBCNVRT,NODE
S VALMBCK="R"
W !,"What is the last dated entry in the conversion log that should be deleted?"
K DIR S DIR(0)="D"
S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-25))
D ^DIR
I '$D(DIRUT),Y>0,Y'>DT S SDATE=Y D
.K DIK S DIK="^IBD(359,"
.S IBCNVRT=0 F S IBCNVRT=$O(^IBD(359,IBCNVRT)) Q:'IBCNVRT S NODE=$G(^IBD(359,IBCNVRT,0)) I $P(NODE,"^",4),$P(NODE,"^",4)'>SDATE S DA=IBCNVRT D ^DIK
.D IDXFORMS
K DIK,Y,DIR,DA,X
Q