- 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 Jan 18, 2025@03:53:11 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