- PSOSDRAP ;BHAM ISC/FLS - action/info profile replacement for print template ;09/22/03 8:24
- ;;7.0;OUTPATIENT PHARMACY;**155,176**;SEP 2003
- ;External reference to GETPLIST^SDAMA202 is supported by DBIA 3869
- ;External reference to ^SC supported by DBIA 10040
- ;called from PSOSD
- Q ; Call from tag
- CLINALL ; All clinics
- N ALL,APIFLDS,CLN,D0,GOTDATA,CHK,SEQ,DFN,CAN,LIST,PAGE,BDT,EDT,IOP
- ;D DEV Q:POP
- S APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12",ALL=1
- S (CLN,GOTDATA)=0
- F S CLN=$O(^SC(CLN)) Q:'CLN D
- .S CHK=$G(^SC(CLN,"I"))
- .I $P(CHK,"^",1)'="",$P(CHK,"^",2)'>$P(CHK,"^",1) Q
- .S $P(FR,",",1)=CLN D CLIN1
- I 'GOTDATA U IO W !?10,"*** NO RECORDS TO PRINT ***"
- D ^%ZISC
- Q
- CLINIC ; Individual Clinics
- N ALL,APIFLDS,D0,SEQ,DFN,CAN,LIST,PAGE,BDT,EDT,IOP
- ;D DEV Q:POP
- S APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12",ALL=0
- CLIN1 ;
- S BDT=$P(FR,",",2),EDT=$P(TO,",",2),D0=$P(FR,",",1)
- I '$D(CLDT) S CLDT=BDT
- D FIND^DIC(44,"","","AX",D0)
- S CLINICX=$G(^TMP("DILIST",$J,1,1))
- K DIC,^TMP("DILIST",$J),^TMP($J,"SDAMA202")
- D GETPLIST^SDAMA202(D0,APIFLDS,"",BDT,EDT,.RSLT)
- I ALL,$D(^TMP($J,"SDAMA202")) S GOTDATA=1
- I 'ALL,'$D(^TMP($J,"SDAMA202")) U IO W !?10,"*** NO RECORDS TO PRINT ***" Q
- S SEQ="",LIST="GETPLIST"
- F S SEQ=$O(^TMP($J,"SDAMA202",LIST,SEQ)) Q:SEQ="" D PAT Q:$D(DIRUT)
- I 'ALL D ^%ZISC
- Q
- PAT ; Individual Patients
- S LIST=$G(LIST) S:LIST="" LIST="GETAPPT" S SEQ=$G(SEQ) S:SEQ="" SEQ=1 S PAGE=1
- S DFN=$P($G(^TMP($J,"SDAMA202",LIST,SEQ,4)),"^",1)
- S CAN=$G(^TMP($J,"SDAMA202",LIST,SEQ,12))
- Q:CAN=""
- I DFN>0 D Q:$D(DIRUT)
- .D HD^PSOSD2 Q:$D(DIRUT)
- .D PAT^PSOSD Q:$D(DIRUT)
- .D RXPAD^PSOSD1:PSTYPE Q:$D(DIRUT)
- .W:'$G(PSTYPE)&('$D(^TMP("PSOD",$J))) @IOF
- .D ENSTUFF^PSODACT
- D ^PSOSD3
- Q
- DEV ;
- S PSOION=ION,%ZIS="QM",%ZIS("B")=""
- D ^%ZIS K %ZIS
- I POP S IOP=PSOION D ^%ZIS K IOP,PSOION
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSDRAP 1856 printed Jan 18, 2025@03:35:58 Page 2
- PSOSDRAP ;BHAM ISC/FLS - action/info profile replacement for print template ;09/22/03 8:24
- +1 ;;7.0;OUTPATIENT PHARMACY;**155,176**;SEP 2003
- +2 ;External reference to GETPLIST^SDAMA202 is supported by DBIA 3869
- +3 ;External reference to ^SC supported by DBIA 10040
- +4 ;called from PSOSD
- +5 ; Call from tag
- QUIT
- CLINALL ; All clinics
- +1 NEW ALL,APIFLDS,CLN,D0,GOTDATA,CHK,SEQ,DFN,CAN,LIST,PAGE,BDT,EDT,IOP
- +2 ;D DEV Q:POP
- +3 SET APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12"
- SET ALL=1
- +4 SET (CLN,GOTDATA)=0
- +5 FOR
- SET CLN=$ORDER(^SC(CLN))
- if 'CLN
- QUIT
- Begin DoDot:1
- +6 SET CHK=$GET(^SC(CLN,"I"))
- +7 IF $PIECE(CHK,"^",1)'=""
- IF $PIECE(CHK,"^",2)'>$PIECE(CHK,"^",1)
- QUIT
- +8 SET $PIECE(FR,",",1)=CLN
- DO CLIN1
- End DoDot:1
- +9 IF 'GOTDATA
- USE IO
- WRITE !?10,"*** NO RECORDS TO PRINT ***"
- +10 DO ^%ZISC
- +11 QUIT
- CLINIC ; Individual Clinics
- +1 NEW ALL,APIFLDS,D0,SEQ,DFN,CAN,LIST,PAGE,BDT,EDT,IOP
- +2 ;D DEV Q:POP
- +3 SET APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12"
- SET ALL=0
- CLIN1 ;
- +1 SET BDT=$PIECE(FR,",",2)
- SET EDT=$PIECE(TO,",",2)
- SET D0=$PIECE(FR,",",1)
- +2 IF '$DATA(CLDT)
- SET CLDT=BDT
- +3 DO FIND^DIC(44,"","","AX",D0)
- +4 SET CLINICX=$GET(^TMP("DILIST",$JOB,1,1))
- +5 KILL DIC,^TMP("DILIST",$JOB),^TMP($JOB,"SDAMA202")
- +6 DO GETPLIST^SDAMA202(D0,APIFLDS,"",BDT,EDT,.RSLT)
- +7 IF ALL
- IF $DATA(^TMP($JOB,"SDAMA202"))
- SET GOTDATA=1
- +8 IF 'ALL
- IF '$DATA(^TMP($JOB,"SDAMA202"))
- USE IO
- WRITE !?10,"*** NO RECORDS TO PRINT ***"
- QUIT
- +9 SET SEQ=""
- SET LIST="GETPLIST"
- +10 FOR
- SET SEQ=$ORDER(^TMP($JOB,"SDAMA202",LIST,SEQ))
- if SEQ=""
- QUIT
- DO PAT
- if $DATA(DIRUT)
- QUIT
- +11 IF 'ALL
- DO ^%ZISC
- +12 QUIT
- PAT ; Individual Patients
- +1 SET LIST=$GET(LIST)
- if LIST=""
- SET LIST="GETAPPT"
- SET SEQ=$GET(SEQ)
- if SEQ=""
- SET SEQ=1
- SET PAGE=1
- +2 SET DFN=$PIECE($GET(^TMP($JOB,"SDAMA202",LIST,SEQ,4)),"^",1)
- +3 SET CAN=$GET(^TMP($JOB,"SDAMA202",LIST,SEQ,12))
- +4 if CAN=""
- QUIT
- +5 IF DFN>0
- Begin DoDot:1
- +6 DO HD^PSOSD2
- if $DATA(DIRUT)
- QUIT
- +7 DO PAT^PSOSD
- if $DATA(DIRUT)
- QUIT
- +8 if PSTYPE
- DO RXPAD^PSOSD1
- if $DATA(DIRUT)
- QUIT
- +9 if '$GET(PSTYPE)&('$DATA(^TMP("PSOD",$JOB)))
- WRITE @IOF
- +10 DO ENSTUFF^PSODACT
- End DoDot:1
- if $DATA(DIRUT)
- QUIT
- +11 DO ^PSOSD3
- +12 QUIT
- DEV ;
- +1 SET PSOION=ION
- SET %ZIS="QM"
- SET %ZIS("B")=""
- +2 DO ^%ZIS
- KILL %ZIS
- +3 IF POP
- SET IOP=PSOION
- DO ^%ZIS
- KILL IOP,PSOION
- +4 QUIT