Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOSDRAP

PSOSDRAP.m

Go to the documentation of this file.
  1. 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
  1. ;External reference to GETPLIST^SDAMA202 is supported by DBIA 3869
  1. ;External reference to ^SC supported by DBIA 10040
  1. ;called from PSOSD
  1. Q ; Call from tag
  1. CLINALL ; All clinics
  1. N ALL,APIFLDS,CLN,D0,GOTDATA,CHK,SEQ,DFN,CAN,LIST,PAGE,BDT,EDT,IOP
  1. ;D DEV Q:POP
  1. S APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12",ALL=1
  1. S (CLN,GOTDATA)=0
  1. F S CLN=$O(^SC(CLN)) Q:'CLN D
  1. .S CHK=$G(^SC(CLN,"I"))
  1. .I $P(CHK,"^",1)'="",$P(CHK,"^",2)'>$P(CHK,"^",1) Q
  1. .S $P(FR,",",1)=CLN D CLIN1
  1. I 'GOTDATA U IO W !?10,"*** NO RECORDS TO PRINT ***"
  1. D ^%ZISC
  1. Q
  1. CLINIC ; Individual Clinics
  1. N ALL,APIFLDS,D0,SEQ,DFN,CAN,LIST,PAGE,BDT,EDT,IOP
  1. ;D DEV Q:POP
  1. S APIFLDS="1;2;3;4;5;6;7;8;9;10;11;12",ALL=0
  1. CLIN1 ;
  1. S BDT=$P(FR,",",2),EDT=$P(TO,",",2),D0=$P(FR,",",1)
  1. I '$D(CLDT) S CLDT=BDT
  1. D FIND^DIC(44,"","","AX",D0)
  1. S CLINICX=$G(^TMP("DILIST",$J,1,1))
  1. K DIC,^TMP("DILIST",$J),^TMP($J,"SDAMA202")
  1. D GETPLIST^SDAMA202(D0,APIFLDS,"",BDT,EDT,.RSLT)
  1. I ALL,$D(^TMP($J,"SDAMA202")) S GOTDATA=1
  1. I 'ALL,'$D(^TMP($J,"SDAMA202")) U IO W !?10,"*** NO RECORDS TO PRINT ***" Q
  1. S SEQ="",LIST="GETPLIST"
  1. F S SEQ=$O(^TMP($J,"SDAMA202",LIST,SEQ)) Q:SEQ="" D PAT Q:$D(DIRUT)
  1. I 'ALL D ^%ZISC
  1. Q
  1. PAT ; Individual Patients
  1. S LIST=$G(LIST) S:LIST="" LIST="GETAPPT" S SEQ=$G(SEQ) S:SEQ="" SEQ=1 S PAGE=1
  1. S DFN=$P($G(^TMP($J,"SDAMA202",LIST,SEQ,4)),"^",1)
  1. S CAN=$G(^TMP($J,"SDAMA202",LIST,SEQ,12))
  1. Q:CAN=""
  1. I DFN>0 D Q:$D(DIRUT)
  1. .D HD^PSOSD2 Q:$D(DIRUT)
  1. .D PAT^PSOSD Q:$D(DIRUT)
  1. .D RXPAD^PSOSD1:PSTYPE Q:$D(DIRUT)
  1. .W:'$G(PSTYPE)&('$D(^TMP("PSOD",$J))) @IOF
  1. .D ENSTUFF^PSODACT
  1. D ^PSOSD3
  1. Q
  1. DEV ;
  1. S PSOION=ION,%ZIS="QM",%ZIS("B")=""
  1. D ^%ZIS K %ZIS
  1. I POP S IOP=PSOION D ^%ZIS K IOP,PSOION
  1. Q