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

APSPRT.m

Go to the documentation of this file. 
  1. APSPRT ; IHS/DSD/ENM - PRINTS PREPACK AND U/D LABELS 7/22/89 ;  [ 09/03/97   1:30 PM ]
  1.  ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
  1.  ;         
  1. START ;
  1.  D ^APSPRT1 ;Sets parameters
  1.  G:$D(APSPRT("QUIT")) END
  1. BODY ;
  1.  D ADD ;Adds entry to APSP PREPACK LOG file.
  1.  I $D(APSPRT("QUIT")) G:APSPRT("QUIT")=1 END D EOJ G BODY
  1.  D ASK ;Asks if correct
  1.  I $D(APSPRT("QUIT")) D EOJ G BODY
  1.  I APSP("TYPE")="P" D EN^APSPRT1 ;Sets sig in correct array
  1.  D PRINT ;Print labels
  1.  G BODY
  1.  ;
  1. END D EOJ ;Clean up variables
  1.  Q  ;End of routine
  1.  ;
  1. ADD ;
  1.  K APSPRT("ADD")
  1.  W !!,"Last Prepack Number : ",APSP("LASTP")
  1.  W "     Last Unit Dose Number : ",APSP("LASTU"),!!
  1.  S DIC(0)="EQMALZ",DIC="^APSPP(31,",DIC("A")="IHS CONTROL # : "
  1.  D ^DIC
  1.  I +Y<0 S APSPRT("QUIT")=$S(X="":1,$D(DUOUT):"1",1:"") G ADDX
  1.  S DIE=DIC,(APSPRT("DA"),DA)=+Y,DR=$S($P(Y,U,3)=1:"[APSP PREPACK LOG ADD]",1:"[APSP PREPACK LOG EDIT]")
  1.  I $P(Y,U,3)=1 S APSPRT("ADD")=""
  1.  D ^DIE
  1.  I '$D(^APSPP(31,APSPRT("DA"),0)) S APSPRT("QUIT")="" G ADDX
  1.  ; The following line of code deletes the entry if no pharmacist is
  1.  ; entered and all the fields not filled in.
  1.  I $D(APSPRT("ADD")),$P(^APSPP(31,APSPRT("DA"),0),U,14)="" S DIK="^APSPP(31,",DA=APSPRT("DA") D ^DIK S APSPRT("QUIT")="" W !!,"DELETED !"
  1.  ;
  1. ADDX ;Exit point for ADD subroutine    
  1.  Q
  1.  ;
  1. ASK ;Asks if label is correct
  1.  D SETVAR
  1.  D DISPLAY
  1.  W !!!,"IS THIS CORRECT (Y/N) "
  1.  S %=1 D YN^DICN
  1.  I %Y=""!(%Y="Y") D YES G ASKX
  1.  I %Y["?" W !,"Enter a 'Y' if you accept this log entry, a 'N' if not and",!,"you wish to continue to edit it.  You may also enter a '^' if you want to",!,"delete this entry." G ASK
  1.  I %Y="^" S APSPRT("QUIT")="" S DIK="^APSPP(31,",DA=APSPRT("DA") D:$D(APSPRT("ADD")) ^DIK W:$D(APSPRT("ADD")) !!,"DELETED !" G ASKX
  1.  D DIE
  1.  G ASK
  1. ASKX ;Exit point for ASK subroutine
  1.  Q
  1. YES ;
  1.  S:APSP("TYPE")'="P"&(APSP(29)="y") APSP("COPIES")=APSP("COPIES")/2
  1.  I '$D(APSPRT("ADD")) G YESX
  1.  I APSP("TYPE")="P" S APSP("LASTP")=$E(APSP("CNTL#"),5,99)
  1.  I APSP("TYPE")'="P" S APSP("LASTU")=$E(APSP("CNTL#"),5,99)
  1.  S ^APSPP(31,"LAST")=APSP("LASTP")_U_APSP("LASTU")
  1. YESX ;
  1.  Q
  1.  ;
  1. SETVAR ;Displays labels
  1.  I $D(^APSPP(31,DA,"TN")),^("TN")="" K ^("TN")
  1.  S APSPLOG=^APSPP(31,DA,0),APSPLBL=^APSPP(31.1,$P(APSPLOG,U,3),0)
  1.  S APSP("COPIES")=$P(APSPLOG,U,9),APSP("QTY")="#"_$P(APSPLOG,U,8)
  1.  S APSP("DRUG")=$S($D(^APSPP(31,DA,"TN")):^("TN"),$D(^PSDRUG($P(APSPLBL,U,1),0)):$P(^(0),U,1),1:"NONE")
  1.  S APSP("EXPDATE")=$P(APSPLOG,U,6),APSP("CNTL#")="CN# "_$P(APSPLOG,U,1)
  1.  S Y=APSP("EXPDATE") X ^DD("DD") S APSPRT("EXPDATE")="Expires: "_Y
  1.  I $L(APSPRT("EXPDATE"))+3+$L(APSP("CNTL#"))>APSP(22) S APSPRT("EXPDATE")="Exp: "_Y
  1.  S APSP("TYPE")=$S($P(APSPLOG,U,7)="P":"P",1:"U")
  1.  I APSP("TYPE")="U" S APSPRT("EXPDATE")="Exp:"_Y
  1.  G:APSP("TYPE")'="P" SETVARX
  1.  S (APSP("SIG"),X)=$P(APSPLBL,U,3) X ^DD(9009031.1,.03,9.2)
  1. SETVARX ;
  1.  Q
  1. DISPLAY ;Displays labels
  1.  I APSP("TYPE")="P" W !!!,$E(APSP("LINE1"),1,APSP(22)),!,APSP("SIG")
  1.  W:APSP("TYPE")'="P" !!
  1.  W !,APSP("DRUG"),?(APSP(22)-$L(APSP("QTY"))),APSP("QTY")
  1.  W !,APSP("CNTL#"),?(APSP(22)-$L(APSPRT("EXPDATE"))),APSPRT("EXPDATE")
  1.  W:APSP("TYPE")="P" !,$E(APSP("LINE2"),1,APSP(22))
  1.  Q
  1. DIE ;     
  1.  S DR="[APSP PREPACK LOG EDIT]"
  1.  D ^DIE
  1.  Q
  1. PRINT ;
  1.  S APSP("PRT")=$S(APSP("TYPE")="P":"^APSPRT2",1:"^APSPRT3")
  1.  S %=1
  1.  W !!,"Do you wish to print the labels (Y/N) "
  1.  D YN^DICN
  1.  I %=0 W !,"If you wish the labels to be printed enter a 'Y',",!,"if not enter a 'N'.  The prepack or unit dose is still recorded." G PRINT
  1.  G:%'=1 PRINTX
  1.  W !! S DIR("A")="Please enter the number of labels you wish to print : "_APSP("COPIES")_"// " ;IHS/DSD/ENM 05/24/96
  1.  S DIR(0)="FO^1:2" D ^DIR K DIR ;IHS/DSD/ENM 05/24/96
  1.  ;R X:DTIME G:'$T PRINTX
  1.  I X'="",X<1!(X="^") G PRINTX ;IHS/OHPRD/JCM 9/22/89
  1.  I X?1N.N!(X="") S APSP("COPIES")=$S(X'="":X,1:APSP("COPIES"))
  1.  D:%=1 @APSP("PRT")
  1. PRINTX ;
  1.  D EOJ ;Cleans up variables
  1.  Q
  1.  ;
  1. EOJ ;Clean up variables
  1.  K APSP("DRUG"),APSP("QTY"),APSPLOG,APSPLBL,DA,DIE,DIC
  1.  K APSP("CNTL#"),APSPIG,APSPRT("EXPDATE"),APSP("TYPE"),APSP("COPIES")
  1.  I $D(APSPRT("QUIT")),APSPRT("QUIT") K APSP,APSPRT
  1.  K X,Y,APSPRT("ADD"),%,%Y,APSPRT("QUIT"),APSP("QTYFLG")
  1.  K APSPGY,APSPGC,DIE,DIC,DIK,DR,II,IOP,POP,DUOUT,APSPZZL,APSPZM,APSPZLA
  1.  K APSPDR,APSPDR1,%ZIS,%ZIS
  1.  Q