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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFC1 2964 printed Dec 13, 2024@02:52 Page 2
IBDFC1 ;ALB/CJM - ENCOUNTER FORM - CONVERTED FORMS LIST ;MAR 3, 1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
LIST ;
+1 NEW IBCLINIC,IBTKFORM,IBTKBLK,IBAPI
+2 SET (IBTKFORM,IBTKBLK,IBCLINIC)=""
+3 SET IBAPI("INDEX")="D IDXFORMS^IBDFC1"
+4 SET IBAPI("SELECT")="D SELECT^IBDFC1"
+5 DO EN^VALM("IBDFC CONVERSION LOG")
+6 DO VALMSG^IBDFC
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
ONENTRY ;
+1 DO IDXFORMS
+2 QUIT
ONEXIT ;
+1 KILL ^TMP("IBDF",$JOB,"CONVERTED FORMS")
+2 QUIT
+3 ;
HDR ;
+1 SET VALMHDR(1)=" *** LOG OF FORMS THAT HAVE BEEN CONVERTED FOR SCANNING ***"
+2 QUIT
+3 ;
IDXFORMS ;build a list of converted forms
+1 NEW IEN
+2 KILL @VALMAR
+3 SET VALMCNT=0
+4 SET IEN=0
FOR
SET IEN=$ORDER(^IBD(359,IEN))
if 'IEN
QUIT
DO ENTRY
+5 QUIT
+6 ;
ENTRY ;adds an entry to the array
+1 NEW NODE,FORM,WARNING,REPLACED
+2 SET NODE=$GET(^IBD(359,IEN,0))
+3 if NODE=""
QUIT
+4 SET FORM=+NODE
+5 SET VALMCNT=VALMCNT+1
+6 SET WARNING=$SELECT($ORDER(^IBD(359,IEN,1,0)):"YES",1:"NO ")
+7 SET REPLACED=$SELECT($PIECE(NODE,"^",5):"YES",1:"NO ")
+8 SET @VALMAR@(VALMCNT,0)=$JUSTIFY(VALMCNT,3)_" "_$$LJ^XLFSTR($PIECE(NODE,"^",3),30)_" "_$$LJ^XLFSTR($$FMTE^XLFDT($PIECE(NODE,"^",4),"2D"),10)_" "_$$CJ^XLFSTR(WARNING,8)_" "_$$CJ^XLFSTR(REPLACED,18)
+9 ;set video for ID column
DO FLDCTRL^VALM10(VALMCNT)
+10 IF WARNING="YES"
DO CNTRL^VALM10(VALMCNT,52,3,IOINHI,IOINORM,0)
+11 IF REPLACED="NO "
DO CNTRL^VALM10(VALMCNT,69,2,IOINHI,IOINORM,0)
+12 SET @VALMAR@("IDX",VALMCNT,VALMCNT)=FORM_"^"_IEN
+13 QUIT
+14 ;
SELECT ;returns IBFORM,IBCNVRT
+1 NEW SEL
+2 KILL DIR
+3 DO EN^VALM2(XQORNOD(0),"S")
+4 SET SEL=$ORDER(VALMY(""))
+5 SET IBFORM=$SELECT('SEL:"",1:+$GET(@VALMAR@("IDX",SEL,SEL)))
+6 SET IBCNVRT=$SELECT('SEL:"",1:$PIECE($GET(@VALMAR@("IDX",SEL,SEL)),"^",2))
+7 QUIT
+8 ;
WARNINGS ;displays conversion warnings
+1 NEW IBFORM,IBARY,IBHDRRTN,IBCNVRT
+2 DO SELECT
+3 if 'IBCNVRT
QUIT
+4 SET IBARY="^IBD(359,"_IBCNVRT_",1)"
+5 SET IBHDRRTN="D WARNHDR^IBDFC1"
+6 DO EN^VALM("IBDE TEXT DISPLAY")
+7 SET VALMBCK="R"
+8 QUIT
WARNHDR ;
+1 SET VALMHDR(1)=" *** Conversion Warnings For "_$PIECE($GET(^IBD(359,IBCNVRT,0)),"^",3)_" ***"
+2 QUIT
+3 ;
DELFORM ;used to delete forms from other places than the clinic setup screen
+1 NEW CLINIC,IBFORM,IBCNVRT,BLOCK,NOCANDO,SETUP,ARY
+2 SET NOCANDO=0
SET ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"
+3 KILL @ARY
+4 SET VALMBCK="R"
+5 IF $GET(IBAPI("SELECT"))'=""
XECUTE IBAPI("SELECT")
+6 if 'IBFORM
QUIT
+7 DO CLINICS^IBDFU4(IBFORM,ARY)
+8 IF $GET(@ARY@(0))
Begin DoDot:1
+9 WRITE !,"Cannot be deleted, the form is in use!"
+10 DO LIST^IBDFU4(ARY,IOSL)
End DoDot:1
+11 IF '$GET(@ARY@(0))
Begin DoDot:1
+12 DO DELETE^IBDFU2C(.IBFORM,357,1)
+13 IF '$GET(IBFORM)
Begin DoDot:2
+14 KILL DIK,DA
SET DIK="^IBD(359,"
SET DA=IBCNVRT
DO ^DIK
KILL DIK,DA
+15 DO IDXFORMS
End DoDot:2
End DoDot:1
+16 KILL @ARY
+17 QUIT
+18 ;
PURGE ;purge the conversion log
+1 NEW SDATE,IBCNVRT,NODE
+2 SET VALMBCK="R"
+3 WRITE !,"What is the last dated entry in the conversion log that should be deleted?"
+4 KILL DIR
SET DIR(0)="D"
+5 SET DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-25))
+6 DO ^DIR
+7 IF '$DATA(DIRUT)
IF Y>0
IF Y'>DT
SET SDATE=Y
Begin DoDot:1
+8 KILL DIK
SET DIK="^IBD(359,"
+9 SET IBCNVRT=0
FOR
SET IBCNVRT=$ORDER(^IBD(359,IBCNVRT))
if 'IBCNVRT
QUIT
SET NODE=$GET(^IBD(359,IBCNVRT,0))
IF $PIECE(NODE,"^",4)
IF $PIECE(NODE,"^",4)'>SDATE
SET DA=IBCNVRT
DO ^DIK
+10 DO IDXFORMS
End DoDot:1
+11 KILL DIK,Y,DIR,DA,X
+12 QUIT
