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

PSGPLG.m

Go to the documentation of this file.
  1. PSGPLG ;BIR/CML3-CHOOSE A PICK LIST ;09 JUL 94 / 11:08 AM
  1. ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
  1. RUN D NOW^%DTC S PSGDT=%,PSGPLG="" D FA K NP,PSGID,PSGOD,S1,S2,W Q
  1. ;
  1. FA ; find and show pick list(s) already started for this ward group
  1. W ! K W S W=0,NP="" F S1=$S(PSGPLGF="U":PSGDT,1:0):0 S S1=$O(^PS(53.5,"AB",PSGPLWG,S1)) Q:'S1 F S2=0:0 S S2=$O(^PS(53.5,"AB",PSGPLWG,S1,S2)) Q:'S2 D WRT G:NP["^" CHW
  1. I PSGPLGF="P",$D(^PS(53.5,"AO",PSGPLWG)) W !," - - - - - - - - - - - - - - - - - FILED AWAY - - - - - - - - - - - - - - - - - "
  1. I F S1=0:0 S S1=$O(^PS(53.5,"AO",PSGPLWG,S1)) Q:'S1 F S2=0:0 S S2=$O(^PS(53.5,"AO",PSGPLWG,S1,S2)) Q:'S2 D WRT G:NP["^" CHW
  1. ;
  1. CHW I 'W W !,"NO MORE PICK LISTS CURRENTLY FOR THIS WARD GROUP." Q
  1. I W>1 F W !!,"Select 1 - ",W,": " R PSGPLG:DTIME W:'$T $C(7) S:'$T PSGPLG="^" Q:"^"[PSGPLG Q:$D(W(PSGPLG)) D:PSGPLG["?" M1 W:PSGPLG'["?" $C(7)," ??"
  1. I W>1 S:PSGPLG=+PSGPLG PSGPLG=W(PSGPLG) Q
  1. F W !!,"THIS IS THE ONLY PICK LIST FOR THIS WARD GROUP. OK" S %=1 D YN^DICN Q:% D M2
  1. S PSGPLG=$S(%=1:W(1),%=2:"",1:"^") Q
  1. ;
  1. M1 W !!,"Choose the number (1-",W,") that corresponds to the PICK LIST that you want to",!,$S(PSGPLGF="U":"UPDATE.",PSGPLGF="D":"enter UNITS DISPENSED.",1:"REPRINT.") Q
  1. M2 W !!,"Enter a 'Y' (or press the RETURN key) to ",$S(PSGPLGF="U":"UPDATE",PSGPLGF="D":"enter UNITS DISPENSED into",1:"PRINT")," this PICK ",$S(PSGPLGF="D":" ",1:"")
  1. W "LIST. Enter an 'N' ",$S(PSGPLGF="U":" ",PSGPLGF="P":" ",1:""),"(or '^') to quit now." Q
  1. ;
  1. WRT ;
  1. I W,'(W#17) W $C(7),!!,"Enter an '^' to stop, or press the RETURN key to continue. " R NP:DTIME W:'$T $C(7) S:'$T NP="^" W:NP'["^" *13,# Q:NP["^"
  1. S W=W+1,W(W)=S2,X=$G(^PS(53.5,S2,0)),Y=$O(^(0)),PSGID=$$ENDTC^PSGMI(S1),PSGOD=$$ENDTC^PSGMI($P(X,"^",4))
  1. W !,$J(W,3)," From: ",PSGID,?30,"Through: ",PSGOD W:$S($P(X,"^",11):'$P(X,"^",9),1:0) " (Did NOT complete run)" W:Y="" " (NO data)" Q