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
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
