- PSGOETO1 ;BIR/CML3-TRANSCRIBE ORDERS (CONT) ;09 JAN 97 / 2:39 PM
- ;;5.0; INPATIENT MEDICATIONS ;**29**;16 DEC 97
- ;
- ; Reference to ^PSSLOCK is supported by DBIA #2789
- ;
- ORSET ;
- ;I $D(PSJOERR) N ORIFN,ORL,ORTS,ORVP
- Q:$G(PSJRFLG) D EN1^PSJHL2(PSGP,"SN",PSGORD) I $G(PSGOEENO),$$LS^PSSLOCK(PSGP,PSGORD)
- WW ;
- Q
- NEW DRUGNAME D DRGDISP^PSJLMUT1(PSGP,PSGORD,50,44,.DRUGNAME,0)
- S UL="",$P(UL,"-",50)="" W !!,UL
- F X=0:0 S X=$O(DRUGNAME(X)) Q:'X W !,DRUGNAME(X)
- ;W $S($D(PSJOERR):"",PSGSCH["PRN":"",PSGST="P":" PRN",1:"")
- W $S(PSGSCH["PRN":"",PSGST="P":" PRN",1:"")
- I PSGSI]"" S PSGSI=$$ENSET^PSGSICHK(PSGSI) W ! F Q=1:1:$L(PSGSI," ") W:$L($P(PSGSI," ",Q))+$X>79 ! W $P(PSGSI," ",Q)," "
- W !,UL,! K UL Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOETO1 724 printed Feb 18, 2025@23:28:52 Page 2
- PSGOETO1 ;BIR/CML3-TRANSCRIBE ORDERS (CONT) ;09 JAN 97 / 2:39 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**29**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PSSLOCK is supported by DBIA #2789
- +4 ;
- ORSET ;
- +1 ;I $D(PSJOERR) N ORIFN,ORL,ORTS,ORVP
- +2 if $GET(PSJRFLG)
- QUIT
- DO EN1^PSJHL2(PSGP,"SN",PSGORD)
- IF $GET(PSGOEENO)
- IF $$LS^PSSLOCK(PSGP,PSGORD)
- WW ;
- +1 QUIT
- +2 NEW DRUGNAME
- DO DRGDISP^PSJLMUT1(PSGP,PSGORD,50,44,.DRUGNAME,0)
- +3 SET UL=""
- SET $PIECE(UL,"-",50)=""
- WRITE !!,UL
- +4 FOR X=0:0
- SET X=$ORDER(DRUGNAME(X))
- if 'X
- QUIT
- WRITE !,DRUGNAME(X)
- +5 ;W $S($D(PSJOERR):"",PSGSCH["PRN":"",PSGST="P":" PRN",1:"")
- +6 WRITE $SELECT(PSGSCH["PRN":"",PSGST="P":" PRN",1:"")
- +7 IF PSGSI]""
- SET PSGSI=$$ENSET^PSGSICHK(PSGSI)
- WRITE !
- FOR Q=1:1:$LENGTH(PSGSI," ")
- if $LENGTH($PIECE(PSGSI," ",Q))+$X>79
- WRITE !
- WRITE $PIECE(PSGSI," ",Q)," "
- +8 WRITE !,UL,!
- KILL UL
- QUIT