- IBDFC ;ALB/CJM - ENCOUNTER FORM - CONVERSION UTILTY ;FEB 30,1995
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- FORMLIST ;
- N IBDEVICE
- N IBFASTXT ;set to 1 for fast exit from system
- S IBFASTXT=0
- D DEVICE^IBDFUA(1,.IBDEVICE)
- K XQORS,VALMEVL
- D VALMSG
- D EN^VALM("IBDFC CONVERSION UTILITY")
- Q
- ONENTRY ;
- S VALMCNT=0 K @VALMAR
- Q
- ONEXIT ;
- D KILL^%ZISS
- K ^TMP("IB",$J),^TMP("IBDF",$J),VALMY,IBQUIT,VALMBCK,X,Y,I,DA,D0
- Q
- ;
- HDR ;
- S VALMHDR(1)=" *** LIST OF FORMS TO CONVERT FOR SCANNING ***"
- I $O(^IBD(359,0)) S VALMHDR(2)=" Converted Forms Exist, Use'View Conversion Log' to view converted forms"
- Q
- REMOVE ;allows user to select a form, then deletes it
- N SEL,FORM,LAST
- K DIR
- D EN^VALM2($G(XQORNOD(0)),"S")
- S SEL=$O(VALMY(""))
- I SEL K @VALMAR@(SEL),@VALMAR@("IDX",SEL)
- ;fill in the hole with the last form on the list
- S LAST=$S(VALMCNT<2:0,SEL=VALMCNT:0,1:VALMCNT)
- I LAST D
- .S FORM=@VALMAR@("IDX",LAST,LAST)
- .K @VALMAR@(LAST),@VALMAR@("IDX",LAST)
- .S VALMCNT=VALMCNT-1
- .D DISPLAY(SEL,FORM)
- S VALMCNT=VALMCNT-1
- D VALMSG
- S VALMBCK="R"
- Q
- ;
- ADDONE ;adds a single form to the list for conversion
- N FORM,NODE,CNV,CNVNM,PREV,IBQUIT
- S NODE="",IBQUIT=0
- S VALMBCK="R"
- S FORM=$$SLCTFORM^IBDFU4("",.NODE) Q:'FORM
- I +$P(NODE,"^",17)>2 W !,"This form is already a version "_$P(NODE,"^",17)_" form!" D PAUSE^IBDFU5,VALMSG Q
- ;
- ; -- see if form already converted
- S CNV=0 F S CNV=$O(^IBD(359,"AORIG",FORM,CNV)) Q:'CNV D
- .S PREV=+$G(^IBD(359,CNV,0))
- .I PREV W !,"This form previously converted, new form name = "_$P($G(^IBE(357,PREV,0)),"^") S IBQUIT=1
- I $O(^IBE(357,"B","CNV."_$E($P(NODE,"^"),1,41),0)) W !!,"Form Name "_"CNV."_$E($P(NODE,"^"),1,41)_" already exists. Form must be renamed first!" D PAUSE^IBDFU5 Q
- D VALMSG
- I IBQUIT D PAUSE^IBDFU5
- ;
- D DISPLAY(VALMCNT+1,FORM)
- D VALMSG
- Q
- ;
- DISPLAY(IDX,FORM) ;
- N NODE
- S NODE=$G(^IBE(357,FORM,0)) Q:NODE=""
- S VALMCNT=VALMCNT+1
- S @VALMAR@(IDX,0)=$J(IDX,3)_" "_$$PADRIGHT^IBDFU($P(NODE,"^"),30)_" "_$E($P(NODE,"^",3),1,80),@VALMAR@("IDX",IDX,IDX)=FORM D FLDCTRL^VALM10(IDX)
- Q
- ;
- CNVTLIST ;
- N IBFORM,IDX,QUIT,PRINT,DIR,DIRUT,DUOUT,DTOUT
- S (QUIT,PRINT)=0
- S VALMBCK="R"
- D FULL^VALM1
- ;
- I $O(@VALMAR@("IDX",0))="" W !!,"No forms on List to convert!" D PAUSE^IBDFU5,VALMSG Q
- ;
- W !!,"Each form on the list will be made scannable. However, the results should be",!,"carefully reviewed before putting the form into use.",!
- K DIR S DIR(0)="Y",DIR("A")="Do you want to print the form(s) after they have been converted",DIR("B")="YES"
- D ^DIR Q:(Y<0)!($D(DIRUT)) K DIR I Y=1 D Q:QUIT
- .S PRINT=1
- .D DEVICE
- ;
- S IBDASK("ADDOTHER")=$$ASKOTH^IBDFC2B Q:IBDASK("ADDOTHER")<0
- S IBDASK("AUTOCHG")=$$ASKAUTO^IBDFC2B Q:IBDASK("AUTOCHG")<0
- ;
- S IDX=0 F S IDX=$O(@VALMAR@("IDX",IDX)) Q:'IDX S IBFORM=$G(@VALMAR@("IDX",IDX,IDX)) Q:'IDX S IBFORM=$$CONVERT^IBDFC2(IBFORM) D:PRINT QUEUE
- I PRINT D ^%ZISC
- K @VALMAR
- D VALMSG
- Q
- ;
- DEVICE ;
- W !,"** You must queue the form to print. **"
- W !,$C(7),"** Forms require 132 columns and a page length of 80 lines. **",!
- ;
- ;queuing is automatic - the device is not opened
- K %IS,%ZIS,IOP S %ZIS="N0Q",%ZIS("A")="Printer to queue to: ",%ZIS("B")="",%ZIS("S")="I $E($P($G(^%ZIS(2,+$G(^%ZIS(1,Y,""SUBTYPE"")),0)),U),1,2)=""P-""" D ^%ZIS
- I POP S QUIT=1
- Q
- ;
- QUEUE S ZTRTN="PRINT^IBDFC",ZTSAVE("IBFORM")="",ZTDESC="ENCOUNTER FORM - FROM CONVERSION",ZTDTH=$H D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
- Q
- ;
- PRINT ;
- D FORM^IBDF2A(IBFORM,0)
- Q
- ;
- VALMSG ;
- I $O(^IBD(359,0)) S VALMSG="Use 'View Conversion Log' to view converted forms."
- I '$O(^IBD(359,0)) S VALMSG="Use 'Add Form to List' to convert a form"
- Q
- ;
- HELP ;
- D FULL^VALM1
- W !!,"To convert a form follow the following steps:"
- W !," 1. Use 'Add Form to List' to select the form. Add all the forms to"
- W !," the list you wish to at this time."
- W !," 2. Use 'Convert List' to convert the forms."
- W !," 3. Use 'View Conversion Log' to review the conversion process and "
- W !," assign the converted form to a clinic.",!
- W !,"Hint: The conversion creates a new copy of your form with the same name"
- W !," as the original but prefixed with 'CNV.'. (i.e. form PRIM CARE"
- W !," would be renamed CNV.PRIM CARE)"
- S X="?" D DISP^XQORM1 W !
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFC 4430 printed Jan 18, 2025@03:53:10 Page 2
- IBDFC ;ALB/CJM - ENCOUNTER FORM - CONVERSION UTILTY ;FEB 30,1995
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- FORMLIST ;
- +1 NEW IBDEVICE
- +2 ;set to 1 for fast exit from system
- NEW IBFASTXT
- +3 SET IBFASTXT=0
- +4 DO DEVICE^IBDFUA(1,.IBDEVICE)
- +5 KILL XQORS,VALMEVL
- +6 DO VALMSG
- +7 DO EN^VALM("IBDFC CONVERSION UTILITY")
- +8 QUIT
- ONENTRY ;
- +1 SET VALMCNT=0
- KILL @VALMAR
- +2 QUIT
- ONEXIT ;
- +1 DO KILL^%ZISS
- +2 KILL ^TMP("IB",$JOB),^TMP("IBDF",$JOB),VALMY,IBQUIT,VALMBCK,X,Y,I,DA,D0
- +3 QUIT
- +4 ;
- HDR ;
- +1 SET VALMHDR(1)=" *** LIST OF FORMS TO CONVERT FOR SCANNING ***"
- +2 IF $ORDER(^IBD(359,0))
- SET VALMHDR(2)=" Converted Forms Exist, Use'View Conversion Log' to view converted forms"
- +3 QUIT
- REMOVE ;allows user to select a form, then deletes it
- +1 NEW SEL,FORM,LAST
- +2 KILL DIR
- +3 DO EN^VALM2($GET(XQORNOD(0)),"S")
- +4 SET SEL=$ORDER(VALMY(""))
- +5 IF SEL
- KILL @VALMAR@(SEL),@VALMAR@("IDX",SEL)
- +6 ;fill in the hole with the last form on the list
- +7 SET LAST=$SELECT(VALMCNT<2:0,SEL=VALMCNT:0,1:VALMCNT)
- +8 IF LAST
- Begin DoDot:1
- +9 SET FORM=@VALMAR@("IDX",LAST,LAST)
- +10 KILL @VALMAR@(LAST),@VALMAR@("IDX",LAST)
- +11 SET VALMCNT=VALMCNT-1
- +12 DO DISPLAY(SEL,FORM)
- End DoDot:1
- +13 SET VALMCNT=VALMCNT-1
- +14 DO VALMSG
- +15 SET VALMBCK="R"
- +16 QUIT
- +17 ;
- ADDONE ;adds a single form to the list for conversion
- +1 NEW FORM,NODE,CNV,CNVNM,PREV,IBQUIT
- +2 SET NODE=""
- SET IBQUIT=0
- +3 SET VALMBCK="R"
- +4 SET FORM=$$SLCTFORM^IBDFU4("",.NODE)
- if 'FORM
- QUIT
- +5 IF +$PIECE(NODE,"^",17)>2
- WRITE !,"This form is already a version "_$PIECE(NODE,"^",17)_" form!"
- DO PAUSE^IBDFU5
- DO VALMSG
- QUIT
- +6 ;
- +7 ; -- see if form already converted
- +8 SET CNV=0
- FOR
- SET CNV=$ORDER(^IBD(359,"AORIG",FORM,CNV))
- if 'CNV
- QUIT
- Begin DoDot:1
- +9 SET PREV=+$GET(^IBD(359,CNV,0))
- +10 IF PREV
- WRITE !,"This form previously converted, new form name = "_$PIECE($GET(^IBE(357,PREV,0)),"^")
- SET IBQUIT=1
- End DoDot:1
- +11 IF $ORDER(^IBE(357,"B","CNV."_$EXTRACT($PIECE(NODE,"^"),1,41),0))
- WRITE !!,"Form Name "_"CNV."_$EXTRACT($PIECE(NODE,"^"),1,41)_" already exists. Form must be renamed first!"
- DO PAUSE^IBDFU5
- QUIT
- +12 DO VALMSG
- +13 IF IBQUIT
- DO PAUSE^IBDFU5
- +14 ;
- +15 DO DISPLAY(VALMCNT+1,FORM)
- +16 DO VALMSG
- +17 QUIT
- +18 ;
- DISPLAY(IDX,FORM) ;
- +1 NEW NODE
- +2 SET NODE=$GET(^IBE(357,FORM,0))
- if NODE=""
- QUIT
- +3 SET VALMCNT=VALMCNT+1
- +4 SET @VALMAR@(IDX,0)=$JUSTIFY(IDX,3)_" "_$$PADRIGHT^IBDFU($PIECE(NODE,"^"),30)_" "_$EXTRACT($PIECE(NODE,"^",3),1,80)
- SET @VALMAR@("IDX",IDX,IDX)=FORM
- DO FLDCTRL^VALM10(IDX)
- +5 QUIT
- +6 ;
- CNVTLIST ;
- +1 NEW IBFORM,IDX,QUIT,PRINT,DIR,DIRUT,DUOUT,DTOUT
- +2 SET (QUIT,PRINT)=0
- +3 SET VALMBCK="R"
- +4 DO FULL^VALM1
- +5 ;
- +6 IF $ORDER(@VALMAR@("IDX",0))=""
- WRITE !!,"No forms on List to convert!"
- DO PAUSE^IBDFU5
- DO VALMSG
- QUIT
- +7 ;
- +8 WRITE !!,"Each form on the list will be made scannable. However, the results should be",!,"carefully reviewed before putting the form into use.",!
- +9 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to print the form(s) after they have been converted"
- SET DIR("B")="YES"
- +10 DO ^DIR
- if (Y<0)!($DATA(DIRUT))
- QUIT
- KILL DIR
- IF Y=1
- Begin DoDot:1
- +11 SET PRINT=1
- +12 DO DEVICE
- End DoDot:1
- if QUIT
- QUIT
- +13 ;
- +14 SET IBDASK("ADDOTHER")=$$ASKOTH^IBDFC2B
- if IBDASK("ADDOTHER")<0
- QUIT
- +15 SET IBDASK("AUTOCHG")=$$ASKAUTO^IBDFC2B
- if IBDASK("AUTOCHG")<0
- QUIT
- +16 ;
- +17 SET IDX=0
- FOR
- SET IDX=$ORDER(@VALMAR@("IDX",IDX))
- if 'IDX
- QUIT
- SET IBFORM=$GET(@VALMAR@("IDX",IDX,IDX))
- if 'IDX
- QUIT
- SET IBFORM=$$CONVERT^IBDFC2(IBFORM)
- if PRINT
- DO QUEUE
- +18 IF PRINT
- DO ^%ZISC
- +19 KILL @VALMAR
- +20 DO VALMSG
- +21 QUIT
- +22 ;
- DEVICE ;
- +1 WRITE !,"** You must queue the form to print. **"
- +2 WRITE !,$CHAR(7),"** Forms require 132 columns and a page length of 80 lines. **",!
- +3 ;
- +4 ;queuing is automatic - the device is not opened
- +5 KILL %IS,%ZIS,IOP
- SET %ZIS="N0Q"
- SET %ZIS("A")="Printer to queue to: "
- SET %ZIS("B")=""
- SET %ZIS("S")="I $E($P($G(^%ZIS(2,+$G(^%ZIS(1,Y,""SUBTYPE"")),0)),U),1,2)=""P-"""
- DO ^%ZIS
- +6 IF POP
- SET QUIT=1
- +7 QUIT
- +8 ;
- QUEUE SET ZTRTN="PRINT^IBDFC"
- SET ZTSAVE("IBFORM")=""
- SET ZTDESC="ENCOUNTER FORM - FROM CONVERSION"
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
- +1 QUIT
- +2 ;
- PRINT ;
- +1 DO FORM^IBDF2A(IBFORM,0)
- +2 QUIT
- +3 ;
- VALMSG ;
- +1 IF $ORDER(^IBD(359,0))
- SET VALMSG="Use 'View Conversion Log' to view converted forms."
- +2 IF '$ORDER(^IBD(359,0))
- SET VALMSG="Use 'Add Form to List' to convert a form"
- +3 QUIT
- +4 ;
- HELP ;
- +1 DO FULL^VALM1
- +2 WRITE !!,"To convert a form follow the following steps:"
- +3 WRITE !," 1. Use 'Add Form to List' to select the form. Add all the forms to"
- +4 WRITE !," the list you wish to at this time."
- +5 WRITE !," 2. Use 'Convert List' to convert the forms."
- +6 WRITE !," 3. Use 'View Conversion Log' to review the conversion process and "
- +7 WRITE !," assign the converted form to a clinic.",!
- +8 WRITE !,"Hint: The conversion creates a new copy of your form with the same name"
- +9 WRITE !," as the original but prefixed with 'CNV.'. (i.e. form PRIM CARE"
- +10 WRITE !," would be renamed CNV.PRIM CARE)"
- +11 SET X="?"
- DO DISP^XQORM1
- WRITE !