- PSODP ;BHAM ISC/JrR - SORT AND PRINT DUE ANSWER SHEETS ; 11/17/92 10:19
- ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- ;
- PSOSUMM W !,"Do you want a Report Summary"
- S %=2 D YN^DICN
- I '% D QUES,QUES1 G PSOSUMM
- G:%=-1 EXIT
- S PSOSUMM=%=1
- I 'PSOSUMM S PSONLY=0 G DIP
- ;
- PSONLY W !,"Do you want a SUMMARY only"
- S %=2 D YN^DICN
- I '% D QUES,QUES2 G PSONLY
- G:%=-1 EXIT
- S PSONLY=%=1
- ;
- DIP K FR,TO,PG,DHIT,DIOEND,DIOBEG,DCOPIES,DIS,PSOQL
- S PSCNT=0
- S DIC="^PS(50.0731,",DHD="@"
- S DIOEND="W:'PSCNT !!,?5,""0 matches found!!!"",!"
- S DHIT="S PSCNT=PSCNT+1"
- I PSOSUMM S DIOBEG="K ^TMP(""PSOD"",$J)",DIOEND="D SUMM^PSODP",DHIT="D ACCUM^PSODP"
- S BY="10,@",L="SORT ANSWER SHEETS",FLDS=$S(PSONLY:"",1:"[PSOD PRINT ANSWER SHEET]")
- D EN1^DIP
- EXIT K %,D0,DCOPIES,DHD,DHIT,DIC,DIOBEG,DIOEND,DIS,FLDS,FR,L,PG,PSOA,PSOATOT
- K PSODA,PSODN,PSODQA,PSONLY,PSOQ,PSOQA,PSOQAM,PSOQATOT,PSOQL,PSOQM
- K PSOQN,PSOSUMM,PSPOP,PSCNT
- K ^TMP("PSOD",$J)
- QUIT
- ACCUM ;Enter here from DHIT="D ACCUM^PSODP"
- ;Requires D0 which is defined from ^DIP call above
- S PSODQA=+$P(^PS(50.0731,D0,0),"^",2)
- S ^(PSODQA)=$S('$D(^TMP("PSOD",$J,PSODQA)):1,1:^(PSODQA)+1)
- Q:'$D(^PS(50.073,PSODQA,0))
- Q:'$D(^PS(50.0731,D0,1,0))
- F PSODN=0:0 S PSODN=$O(^PS(50.0731,D0,1,PSODN)) Q:'PSODN S PSOQN=$P(^(PSODN,0),"^",2),PSOQM=+$P(^(0),"^") I $D(^PS(50.0732,PSOQN,0)),$P(^(0),"^",2)=1 D COUNT
- QUIT
- COUNT S PSODA=$S($D(^PS(50.0731,D0,1,PSODN,1)):^(1),1:"")
- S:PSODA="" PSODA="NULL"
- S ^(PSODA)=$S('$D(^TMP("PSOD",$J,PSODQA,PSOQM,PSODA)):1,1:^(PSODA)+1)
- Q
- SUMM ;Enter here from ^DIP to print Summary
- W:$Y @IOF
- S PSOQATOT=0,PSOATOT=0,$P(PSOQL,"-",IOM)=""
- F PSOA=-1:0 S PSOA=$O(^TMP("PSOD",$J,PSOA)) Q:PSOA="" S PSOQATOT=PSOQATOT+1,PSOATOT=PSOATOT+^(PSOA)
- W !!!,"Following is a Summary of the DUE Questionnaires and the",!,"corresponding Answers found in your report."
- W !,"This Summary contains a cumulative total of the YES/NO/UNKNOWN type answers.",!!
- I $D(^TMP("PSOD",$J,0)),^(0) S %=^(0) W !,%," ANSWER SHEET"_$S(%>1:"S",1:"")_" HAD A MISSING QUESTIONNAIRE FIELD!" S PSOQATOT=PSOQATOT-1
- W !!!,"TOTAL ANSWER SHEETS FOUND: ",PSOATOT
- W !,"TOTAL QUESTIONNAIRES FOUND: ",PSOQATOT
- S PSPOP=0
- F PSOQA=0:0 S PSOQA=$O(^TMP("PSOD",$J,PSOQA)) Q:'PSOQA!PSPOP D SUMMHD Q:PSPOP F PSOQ=0:0 S PSOQ=$O(^TMP("PSOD",$J,PSOQA,PSOQ)) Q:'PSOQ D SUMMOUT
- W:$E(IOST)="P"&$Y @IOF
- Q
- SUMMOUT W !?(2-($L(PSOQ)\2)),PSOQ
- S %=$S($D(^TMP("PSOD",$J,PSOQA,PSOQ,"YES")):^("YES"),1:0) W ?(16-($L(%)\2)),%
- S %=$S($D(^TMP("PSOD",$J,PSOQA,PSOQ,"NO")):^("NO"),1:0) W ?(25-($L(%)\2)),%
- S %=$S($D(^TMP("PSOD",$J,PSOQA,PSOQ,"UNKNOWN")):^("UNKNOWN"),1:0) W ?(38-($L(%)\2)),%
- S %=$S($D(^TMP("PSOD",$J,PSOQA,PSOQ,"NULL")):^("NULL"),1:0) W ?(56-($L(%)\2)),%
- Q
- SUMMHD I $E(IOST)="C" S DIR(0)="E" W !! D ^DIR I X="^" S PSPOP=1 Q
- W @IOF
- S PSOQAM=$P(^PS(50.073,PSOQA,0),"^")
- W !!?(40-($L(PSOQAM)\2)),PSOQAM
- W !!,"Number of Answer Sheets: ",^TMP("PSOD",$J,PSOQA)
- W !!,"QUEST #",?15,"YES",?25,"NO",?35,"UNKNOWN",?50,"NOT ANSWERED"
- W !,PSOQL
- W:'$O(^TMP("PSOD",$J,PSOQA,0)) !!,"*** This Questionnaire has no YES/NO/UNKNOWN type answers. ***"
- Q
- QUES W !?5,"A Summary will be printed at the end of this report detailing the"
- W !?5,"number of times a question was answered YES, NO, UNKNOWN, or NOT ANSWERED."
- Q
- QUES2 W !?5,"Answer 'YES' if you want to see the Summary ONLY."
- Q
- QUES1 W !?5,"Answer 'YES' if you want to print this Summary."
- Q
- PSODP ;BHAM ISC/JrR - SORT AND PRINT DUE ANSWER SHEETS ; 11/17/92 10:19
- +1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- +2 ;
- PSOSUMM WRITE !,"Do you want a Report Summary"
- +1 SET %=2
- DO YN^DICN
- +2 IF '%
- DO QUES
- DO QUES1
- GOTO PSOSUMM
- +3 IF %=-1
- GOTO EXIT
- +4 SET PSOSUMM=%=1
- +5 IF 'PSOSUMM
- SET PSONLY=0
- GOTO DIP
- +6 ;
- PSONLY WRITE !,"Do you want a SUMMARY only"
- +1 SET %=2
- DO YN^DICN
- +2 IF '%
- DO QUES
- DO QUES2
- GOTO PSONLY
- +3 IF %=-1
- GOTO EXIT
- +4 SET PSONLY=%=1
- +5 ;
- DIP KILL FR,TO,PG,DHIT,DIOEND,DIOBEG,DCOPIES,DIS,PSOQL
- +1 SET PSCNT=0
- +2 SET DIC="^PS(50.0731,"
- SET DHD="@"
- +3 SET DIOEND="W:'PSCNT !!,?5,""0 matches found!!!"",!"
- +4 SET DHIT="S PSCNT=PSCNT+1"
- +5 IF PSOSUMM
- SET DIOBEG="K ^TMP(""PSOD"",$J)"
- SET DIOEND="D SUMM^PSODP"
- SET DHIT="D ACCUM^PSODP"
- +6 SET BY="10,@"
- SET L="SORT ANSWER SHEETS"
- SET FLDS=$SELECT(PSONLY:"",1:"[PSOD PRINT ANSWER SHEET]")
- +7 DO EN1^DIP
- EXIT KILL %,D0,DCOPIES,DHD,DHIT,DIC,DIOBEG,DIOEND,DIS,FLDS,FR,L,PG,PSOA,PSOATOT
- +1 KILL PSODA,PSODN,PSODQA,PSONLY,PSOQ,PSOQA,PSOQAM,PSOQATOT,PSOQL,PSOQM
- +2 KILL PSOQN,PSOSUMM,PSPOP,PSCNT
- +3 KILL ^TMP("PSOD",$JOB)
- +4 QUIT
- ACCUM ;Enter here from DHIT="D ACCUM^PSODP"
- +1 ;Requires D0 which is defined from ^DIP call above
- +2 SET PSODQA=+$PIECE(^PS(50.0731,D0,0),"^",2)
- +3 SET ^(PSODQA)=$SELECT('$DATA(^TMP("PSOD",$JOB,PSODQA)):1,1:^(PSODQA)+1)
- +4 IF '$DATA(^PS(50.073,PSODQA,0))
- QUIT
- +5 IF '$DATA(^PS(50.0731,D0,1,0))
- QUIT
- +6 FOR PSODN=0:0
- SET PSODN=$ORDER(^PS(50.0731,D0,1,PSODN))
- IF 'PSODN
- QUIT
- SET PSOQN=$PIECE(^(PSODN,0),"^",2)
- SET PSOQM=+$PIECE(^(0),"^")
- IF $DATA(^PS(50.0732,PSOQN,0))
- IF $PIECE(^(0),"^",2)=1
- DO COUNT
- +7 QUIT
- COUNT SET PSODA=$SELECT($DATA(^PS(50.0731,D0,1,PSODN,1)):^(1),1:"")
- +1 IF PSODA=""
- SET PSODA="NULL"
- +2 SET ^(PSODA)=$SELECT('$DATA(^TMP("PSOD",$JOB,PSODQA,PSOQM,PSODA)):1,1:^(PSODA)+1)
- +3 QUIT
- SUMM ;Enter here from ^DIP to print Summary
- +1 IF $Y
- WRITE @IOF
- +2 SET PSOQATOT=0
- SET PSOATOT=0
- SET $PIECE(PSOQL,"-",IOM)=""
- +3 FOR PSOA=-1:0
- SET PSOA=$ORDER(^TMP("PSOD",$JOB,PSOA))
- IF PSOA=""
- QUIT
- SET PSOQATOT=PSOQATOT+1
- SET PSOATOT=PSOATOT+^(PSOA)
- +4 WRITE !!!,"Following is a Summary of the DUE Questionnaires and the",!,"corresponding Answers found in your report."
- +5 WRITE !,"This Summary contains a cumulative total of the YES/NO/UNKNOWN type answers.",!!
- +6 IF $DATA(^TMP("PSOD",$JOB,0))
- IF ^(0)
- SET %=^(0)
- WRITE !,%," ANSWER SHEET"_$SELECT(%>1:"S",1:"")_" HAD A MISSING QUESTIONNAIRE FIELD!"
- SET PSOQATOT=PSOQATOT-1
- +7 WRITE !!!,"TOTAL ANSWER SHEETS FOUND: ",PSOATOT
- +8 WRITE !,"TOTAL QUESTIONNAIRES FOUND: ",PSOQATOT
- +9 SET PSPOP=0
- +10 FOR PSOQA=0:0
- SET PSOQA=$ORDER(^TMP("PSOD",$JOB,PSOQA))
- IF 'PSOQA!PSPOP
- QUIT
- DO SUMMHD
- IF PSPOP
- QUIT
- FOR PSOQ=0:0
- SET PSOQ=$ORDER(^TMP("PSOD",$JOB,PSOQA,PSOQ))
- IF 'PSOQ
- QUIT
- DO SUMMOUT
- +11 IF $EXTRACT(IOST)="P"&$Y
- WRITE @IOF
- +12 QUIT
- SUMMOUT WRITE !?(2-($LENGTH(PSOQ)\2)),PSOQ
- +1 SET %=$SELECT($DATA(^TMP("PSOD",$JOB,PSOQA,PSOQ,"YES")):^("YES"),1:0)
- WRITE ?(16-($LENGTH(%)\2)),%
- +2 SET %=$SELECT($DATA(^TMP("PSOD",$JOB,PSOQA,PSOQ,"NO")):^("NO"),1:0)
- WRITE ?(25-($LENGTH(%)\2)),%
- +3 SET %=$SELECT($DATA(^TMP("PSOD",$JOB,PSOQA,PSOQ,"UNKNOWN")):^("UNKNOWN"),1:0)
- WRITE ?(38-($LENGTH(%)\2)),%
- +4 SET %=$SELECT($DATA(^TMP("PSOD",$JOB,PSOQA,PSOQ,"NULL")):^("NULL"),1:0)
- WRITE ?(56-($LENGTH(%)\2)),%
- +5 QUIT
- SUMMHD IF $EXTRACT(IOST)="C"
- SET DIR(0)="E"
- WRITE !!
- DO ^DIR
- IF X="^"
- SET PSPOP=1
- QUIT
- +1 WRITE @IOF
- +2 SET PSOQAM=$PIECE(^PS(50.073,PSOQA,0),"^")
- +3 WRITE !!?(40-($LENGTH(PSOQAM)\2)),PSOQAM
- +4 WRITE !!,"Number of Answer Sheets: ",^TMP("PSOD",$JOB,PSOQA)
- +5 WRITE !!,"QUEST #",?15,"YES",?25,"NO",?35,"UNKNOWN",?50,"NOT ANSWERED"
- +6 WRITE !,PSOQL
- +7 IF '$ORDER(^TMP("PSOD",$JOB,PSOQA,0))
- WRITE !!,"*** This Questionnaire has no YES/NO/UNKNOWN type answers. ***"
- +8 QUIT
- QUES WRITE !?5,"A Summary will be printed at the end of this report detailing the"
- +1 WRITE !?5,"number of times a question was answered YES, NO, UNKNOWN, or NOT ANSWERED."
- +2 QUIT
- QUES2 WRITE !?5,"Answer 'YES' if you want to see the Summary ONLY."
- +1 QUIT
- QUES1 WRITE !?5,"Answer 'YES' if you want to print this Summary."
- +1 QUIT
