- IBDFDE9 ;ALB/AAS - AICS Manual Data Entry, Report of inputs by form ; 31-MAY-96
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- % N I,J,X,Y,DIR,DIRUT,DTOUT,DUOUT,IBDF,IBDFMIEN,IBDPAG,IBDPDT,IBDOJB,IBQUIT,QLFR,RULE
- ;
- I '$D(DT) D DT^DICRW
- D HOME^%ZIS
- W !!,"Display Form Components for Data Entry",!!
- ;
- STRT ; -- ask for form id
- D END
- S DIR("?")="Enter the Encounter Form Name you want to review."
- S DIR(0)="PO^357:AEQM",DIR("A")="Select Encounter Form" D ^DIR K DIR,DA,DR,DIC
- I $D(DIRUT) G END
- S IBDFMIEN=+Y
- ;
- ; -- Ask Device
- S %ZIS="MQ" D ^%ZIS I POP G STRTQ
- ; -- queue if selected
- I $D(IO("Q")) S ZTSAVE("IBD*")="",ZTRTN="DQ^IBDFDE9",ZTDESC="IBD - Print form components" D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled") D HOME^%ZIS W !! G STRT
- U IO
- S X="IOINHI;IOINORM" D ENDR^%ZISS
- D DQ
- ;
- STRTQ G:$G(IBQUIT) END D PAUSE^IBDFDE
- G STRT
- ;
- DQ ; -- entry point to list contents of one form,
- ; Input IBDFMIEN := pointer to Encounter Form (357)
- ;
- S IBQUIT=0
- S IBDPAG=0
- S IBDPDT=$$FMTE^XLFDT($$NOW^XLFDT)
- D HDR
- ;
- I '$D(^TMP("IBD-OBJ",$J,IBDFMIEN,0)) D FRMLSTI^IBDFRPC("^TMP(""IBD-OBJ"",$J,IBDFMIEN)",IBDFMIEN,"",1)
- D LISTOB
- Q
- ;
- LISTOB ; -- list items available for input on a form
- W !,"CHECKOUT INTERVIEW",?27,"",?45,"As Required",!
- S I=0 F S I=$O(^TMP("IBD-OBJ",$J,IBDFMIEN,I)) Q:I=""!(IBQUIT) D
- .I $E(IOST,1,2)="C-",$Y>(IOSL-5) D HDR Q:IBQUIT
- .S IBDOBJ=$G(^TMP("IBD-OBJ",$J,IBDFMIEN,I))
- .Q:'$P(IBDOBJ,"^",8)
- .S IBDF("PI")=+$P(IBDOBJ,"^",2),IBDF("TYPE")=$P(IBDOBJ,"^",5)
- .S IBDF("IEN")=+$P(IBDOBJ,"^",6),IBDF("VITAL")=$P(IBDOBJ,"^",7)
- .Q:IBDF("IEN")<1!(IBDF("PI")<1)
- .S RTN=$G(^IBE(357.6,IBDF("PI"),18)) Q:RTN=""
- .S Y=$S($P(IBDOBJ,"^",7)="":$P(IBDOBJ,"^"),1:$P(IBDOBJ,"^",7))
- .I Y["INPUT " S Y=$P(Y,"INPUT ",2)
- .W !,$E(Y,1,25),?27,$S(IBDF("TYPE")="HP":"Hand Print",IBDF("TYPE")="LIST":"Selection List",1:"Multiple Choice")
- .;
- .S IBDF("DFN")=$O(^DPT(0)),IBDF("CLINIC")=$O(^SC(0)),IBDF("RULE-ONLY")=1
- .S RULE(0)=$G(^TMP("IBD-LST",$J,IBDFMIEN,IBDF("PI"),IBDF("IEN")))
- .I RULE(0)="" D OBJLST^IBDFRPC1(.RULE,.IBDF)
- .D RULES(.RULE)
- .W !
- W !
- Q
- ;
- HDR ; -- print patient header
- S IBDPAG=IBDPAG+1
- I $E(IOST,1,2)="C-",$Y>1,IBDPAG>1 D PAUSE^IBDFDE Q:IBQUIT
- I $E(IOST,1,2)="C-"!(IBDPAG>1) W @IOF
- W !,"Form Components Available for Data Entry",?IOM-32,IBDPDT," PAGE: ",IBDPAG
- W !,"COMPONENT",?27,"TYPE",?45,"RULE",?60,"QUALIFIER"
- W !,$TR($J(" ",IOM)," ","-")
- W !," Form Name: ",$E($P($G(^IBE(357,+IBDFMIEN,0)),"^"),1,25)
- W !," Form Status: ",$S(+$P($G(^IBE(357,+IBDFMIEN,0)),"^",5):"Compiled",1:"Uncompiled"),!
- Q
- ;
- END I $D(ZTQUEUED) S ZTREQ="@" Q
- K I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF,IBDPAG,ZTSK
- K ^TMP("IBD-OBJ",$J)
- D ^%ZISC
- Q
- ;
- RULES(RULE) ; -- look at zero node, find qualifiers and selection rule
- N I,QLFR,DQR
- S RULE=$P(RULE(0),"^",3),QLFR=""
- I $P(RULE(0),"^",4) W ?45,"Data Entry Not allowed",!,?45,"Marking areas not Bubbles" Q
- F I=1:1 S ROW=$P(RULE,"::",I) Q:ROW="" S QLFR(I)=$P(ROW,";;",1),RULE(I)=$P(ROW,";;",2) D
- .W:I>1 !
- .;
- .I IBDF("VITAL")="" W ?45,$P("Any Number^Exactly One^At Most One^At Least One","^",(RULE(I)+1))
- .E W ?45,"Optional"
- .;
- .I IBDF("VITAL")'="",QLFR(I)[":" S QLFR(I)=$P(QLFR(I),":") ;strip ":"
- .W ?60,$E(QLFR(I),1,20)
- .I QLFR(I)="",$P($G(^IBE(357.6,+$G(IBDF("PI")),0)),"^",19) W ?60,$G(IOINHI),"Required/Missing",$G(IOINORM)
- .I QLFR(I)="PRIMARY" D
- ..;S RULE(I)=$S(RULE(I)=3:1,RULE(I)=0:2,1:RULE(I))
- S RULE=I-1
- Q
- IBDFDE9 ;ALB/AAS - AICS Manual Data Entry, Report of inputs by form ; 31-MAY-96
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- % NEW I,J,X,Y,DIR,DIRUT,DTOUT,DUOUT,IBDF,IBDFMIEN,IBDPAG,IBDPDT,IBDOJB,IBQUIT,QLFR,RULE
- +1 ;
- +2 IF '$DATA(DT)
- DO DT^DICRW
- +3 DO HOME^%ZIS
- +4 WRITE !!,"Display Form Components for Data Entry",!!
- +5 ;
- STRT ; -- ask for form id
- +1 DO END
- +2 SET DIR("?")="Enter the Encounter Form Name you want to review."
- +3 SET DIR(0)="PO^357:AEQM"
- SET DIR("A")="Select Encounter Form"
- DO ^DIR
- KILL DIR,DA,DR,DIC
- +4 IF $DATA(DIRUT)
- GOTO END
- +5 SET IBDFMIEN=+Y
- +6 ;
- +7 ; -- Ask Device
- +8 SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- GOTO STRTQ
- +9 ; -- queue if selected
- +10 IF $DATA(IO("Q"))
- SET ZTSAVE("IBD*")=""
- SET ZTRTN="DQ^IBDFDE9"
- SET ZTDESC="IBD - Print form components"
- DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
- DO HOME^%ZIS
- WRITE !!
- GOTO STRT
- +11 USE IO
- +12 SET X="IOINHI;IOINORM"
- DO ENDR^%ZISS
- +13 DO DQ
- +14 ;
- STRTQ IF $GET(IBQUIT)
- GOTO END
- DO PAUSE^IBDFDE
- +1 GOTO STRT
- +2 ;
- DQ ; -- entry point to list contents of one form,
- +1 ; Input IBDFMIEN := pointer to Encounter Form (357)
- +2 ;
- +3 SET IBQUIT=0
- +4 SET IBDPAG=0
- +5 SET IBDPDT=$$FMTE^XLFDT($$NOW^XLFDT)
- +6 DO HDR
- +7 ;
- +8 IF '$DATA(^TMP("IBD-OBJ",$JOB,IBDFMIEN,0))
- DO FRMLSTI^IBDFRPC("^TMP(""IBD-OBJ"",$J,IBDFMIEN)",IBDFMIEN,"",1)
- +9 DO LISTOB
- +10 QUIT
- +11 ;
- LISTOB ; -- list items available for input on a form
- +1 WRITE !,"CHECKOUT INTERVIEW",?27,"",?45,"As Required",!
- +2 SET I=0
- FOR
- SET I=$ORDER(^TMP("IBD-OBJ",$JOB,IBDFMIEN,I))
- IF I=""!(IBQUIT)
- QUIT
- Begin DoDot:1
- +3 IF $EXTRACT(IOST,1,2)="C-"
- IF $Y>(IOSL-5)
- DO HDR
- IF IBQUIT
- QUIT
- +4 SET IBDOBJ=$GET(^TMP("IBD-OBJ",$JOB,IBDFMIEN,I))
- +5 IF '$PIECE(IBDOBJ,"^",8)
- QUIT
- +6 SET IBDF("PI")=+$PIECE(IBDOBJ,"^",2)
- SET IBDF("TYPE")=$PIECE(IBDOBJ,"^",5)
- +7 SET IBDF("IEN")=+$PIECE(IBDOBJ,"^",6)
- SET IBDF("VITAL")=$PIECE(IBDOBJ,"^",7)
- +8 IF IBDF("IEN")<1!(IBDF("PI")<1)
- QUIT
- +9 SET RTN=$GET(^IBE(357.6,IBDF("PI"),18))
- IF RTN=""
- QUIT
- +10 SET Y=$SELECT($PIECE(IBDOBJ,"^",7)="":$PIECE(IBDOBJ,"^"),1:$PIECE(IBDOBJ,"^",7))
- +11 IF Y["INPUT "
- SET Y=$PIECE(Y,"INPUT ",2)
- +12 WRITE !,$EXTRACT(Y,1,25),?27,$SELECT(IBDF("TYPE")="HP":"Hand Print",IBDF("TYPE")="LIST":"Selection List",1:"Multiple Choice")
- +13 ;
- +14 SET IBDF("DFN")=$ORDER(^DPT(0))
- SET IBDF("CLINIC")=$ORDER(^SC(0))
- SET IBDF("RULE-ONLY")=1
- +15 SET RULE(0)=$GET(^TMP("IBD-LST",$JOB,IBDFMIEN,IBDF("PI"),IBDF("IEN")))
- +16 IF RULE(0)=""
- DO OBJLST^IBDFRPC1(.RULE,.IBDF)
- +17 DO RULES(.RULE)
- +18 WRITE !
- End DoDot:1
- +19 WRITE !
- +20 QUIT
- +21 ;
- HDR ; -- print patient header
- +1 SET IBDPAG=IBDPAG+1
- +2 IF $EXTRACT(IOST,1,2)="C-"
- IF $Y>1
- IF IBDPAG>1
- DO PAUSE^IBDFDE
- IF IBQUIT
- QUIT
- +3 IF $EXTRACT(IOST,1,2)="C-"!(IBDPAG>1)
- WRITE @IOF
- +4 WRITE !,"Form Components Available for Data Entry",?IOM-32,IBDPDT," PAGE: ",IBDPAG
- +5 WRITE !,"COMPONENT",?27,"TYPE",?45,"RULE",?60,"QUALIFIER"
- +6 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
- +7 WRITE !," Form Name: ",$EXTRACT($PIECE($GET(^IBE(357,+IBDFMIEN,0)),"^"),1,25)
- +8 WRITE !," Form Status: ",$SELECT(+$PIECE($GET(^IBE(357,+IBDFMIEN,0)),"^",5):"Compiled",1:"Uncompiled"),!
- +9 QUIT
- +10 ;
- END IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +1 KILL I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF,IBDPAG,ZTSK
- +2 KILL ^TMP("IBD-OBJ",$JOB)
- +3 DO ^%ZISC
- +4 QUIT
- +5 ;
- RULES(RULE) ; -- look at zero node, find qualifiers and selection rule
- +1 NEW I,QLFR,DQR
- +2 SET RULE=$PIECE(RULE(0),"^",3)
- SET QLFR=""
- +3 IF $PIECE(RULE(0),"^",4)
- WRITE ?45,"Data Entry Not allowed",!,?45,"Marking areas not Bubbles"
- QUIT
- +4 FOR I=1:1
- SET ROW=$PIECE(RULE,"::",I)
- IF ROW=""
- QUIT
- SET QLFR(I)=$PIECE(ROW,";;",1)
- SET RULE(I)=$PIECE(ROW,";;",2)
- Begin DoDot:1
- +5 IF I>1
- WRITE !
- +6 ;
- +7 IF IBDF("VITAL")=""
- WRITE ?45,$PIECE("Any Number^Exactly One^At Most One^At Least One","^",(RULE(I)+1))
- +8 IF '$TEST
- WRITE ?45,"Optional"
- +9 ;
- +10 ;strip ":"
- IF IBDF("VITAL")'=""
- IF QLFR(I)[":"
- SET QLFR(I)=$PIECE(QLFR(I),":")
- +11 WRITE ?60,$EXTRACT(QLFR(I),1,20)
- +12 IF QLFR(I)=""
- IF $PIECE($GET(^IBE(357.6,+$GET(IBDF("PI")),0)),"^",19)
- WRITE ?60,$GET(IOINHI),"Required/Missing",$GET(IOINORM)
- +13 IF QLFR(I)="PRIMARY"
- Begin DoDot:2
- +14 ;S RULE(I)=$S(RULE(I)=3:1,RULE(I)=0:2,1:RULE(I))
- End DoDot:2
- End DoDot:1
- +15 SET RULE=I-1
- +16 QUIT