PSGLOI ;BIR/CML3 - ORDER INFO (AND PRINT) FOR LABELS ;30 Apr 98 / 4:41 PM
;;5.0;INPATIENT MEDICATIONS;**7,44,58,110,111,138,197**;16 DEC 97;Build 3
;
;Reference to ^PS(51.2 is supported by DBIA 2178.
;Reference to ^PSD(58.8 is supported by DBIA 2283.
;Reference to ^PSI(58.1 is supported by DBIA 2284.
;Reference to ^PS(55 supported by DBIA #2191.
;
ENOI ;
S F="^PS("_$S(PSGORD["N":"53.1,",PSGORD["P":"53.1,",1:"55,"_PSGOP_",5,")_+PSGORD_","
; the quit below corrects an error if the Order has been moved to 55
Q:'$D(@(F_"0)"))
S ND=$G(@(F_"0)")),PSGLPR=$P(ND,"^",2),PSGLMR=$P(ND,"^",3),PSGLST=$P(ND,"^",7),PSGLSTAT=$P(ND,"^",9),PSGLTD=$P(ND,"^",12),PSGLOD=$P(ND,"^",14),PSGLSM=$S('$P(ND,"^",5):0,$P(ND,"^",6):1,1:2),NG=$P(ND,"^",22)
S ND=$G(@(F_".2)")),PSGLDRG=$P(ND,"^"),PSGLDDA=+ND,PSGLDO=$P(ND,"^",2)
S PSGCLN=$S(F[53.1:$G(@(F_"""DSS"")")),1:$G(@(F_"8)"))) I PSGCLN]"" S PSGLWDN=$P(^SC($P(PSGCLN,"^"),0),"^")
;
SET ;
; naked references below refer to full reference inside indirection @(F_"2)" for either file 53.1 or 55
K PSGLAT S ND=$G(@(F_"2)")),(PSGLSSD,PSGLSD)=$P(ND,"^",2),(PSGLFFD,PSGLFD)=$P(ND,"^",4),PSGLAT=$P(ND,"^",5),PSGLMN=$P(ND,"^",6),PSGLSCH=$P(ND,"^"),ND=$G(^(7)),PSGLDT=+ND,PSGLR=$P(ND,"^",2)
I PSGLST'="R",PSGLMN="D",PSGLAT="" S PSGLAT=$E($P(PSGLSD,".",2)_"0000",1,4)
I PSGLAT,PSGLSCH["@" S PSGLSCH=$P(PSGLSCH,"@")
S (PSGLAT(0),X)=0 I PSGLFD]"",PSGLFD'>PSGDT S (PSGLAT(0),X)=5,(PSGLAT(1),PSGLAT(2),PSGLAT(4),PSGLAT(5))="****",PSGLAT(3)=$S(PSGLSTAT["D":"DC'D",1:"EX'D")
E I $S(PSGLSTAT="P":1,PSGLSTAT="U":1,PSGLST="OC":1,PSGLST="P":1,1:PSGLSCH["PRN") S PSGLAT=""
E I PSGLAT S PSGLAT(0)=$L(PSGLAT,"-"),X=0 D
.F Q=1:1:5 S PSGLAT(Q)=""
.S Q=PSGLAT(0),Y=PSGLAT I Q=1 S PSGLAT(3)=$P(Y,"-") Q
.I Q=2 S PSGLAT(1)=$P(Y,"-"),PSGLAT(5)=$P(Y,"-",2) Q
.I Q=3 S PSGLAT(1)=$P(Y,"-"),PSGLAT(3)=$P(Y,"-",2),PSGLAT(5)=$P(Y,"-",3) Q
.F Q=1:1:PSGLAT(0) S X=X+1,PSGLAT(X)=$P(PSGLAT,"-",Q) I PSGLAT(0)<4 S X=X+1 S:Q<5 PSGLAT(X)=""
I X<5 F Q=X+1:1:5 S:'$G(PSGLAT(Q)) PSGLAT(Q)=""
I $G(DFN),$G(PSGORD) N PSGLREN S PSGLREN=+$$LASTREN^PSJLMPRI(DFN,PSGORD)
S ND=$G(@(F_"4)")),PSGLRN=+ND,PSGLRPH=+$P(ND,"^",3) N PSGLRNDT S PSGLRNDT=$P(ND,"^",2) I PSGLRNDT,$G(PSGLREN) I $G(PSGLREN)>PSGLRNDT S PSGLRN=0
S:+$G(PSGLREN) PSGLREN=$$ENDTC^PSGMI(PSGLREN)
I NG S PSGLSI="*** NOT TO BE GIVEN ***"
E S PSGLSI=$P($G(@(F_"6)")),"^") S:PSGLSI]"" PSGLSI=$$ENSET^PSGSICHK(PSGLSI)
; naked references below refer to full reference inside indirection @(F_"2)" for either file 53.1 or 55
I PSGLSI="",$P(@(F_"0)"),U,9)="P",$O(@(F_"12,0)")) S X=0 F S X=$O(@(F_"12,"_X_")")) Q:'X S Z=$G(^(X,0)),Y=$L(PSGLSI) S:Y+$L(Z)'>179 PSGLSI=PSGLSI_Z_" " I Y+$L(Z)>179 S PSGLSI="SEE PROVIDER COMMENTS" Q
S PSGLDT=$$ENDTC^PSGMI(PSGLDT),PSGLOD=$E($$ENDTC^PSGMI(PSGLOD),1,5)
I PSGLSTAT="P"!(PSGLSTAT="U") S PSGLSD=" ",PSGLFD=" ",PSGLST=" "
E S PSGLSD=$$ENDTC1^PSGMI(PSGLSD),PSGLSD=$E(PSGLSD,1,5)_$E(PSGLSD,9,14),PSGLFD=$$ENDTC1^PSGMI(PSGLFD)
S:'PSGLRN PSGLRN="_____" I PSGLRN,$D(^VA(200,+PSGLRN,0))#2 S X=^(0),X=$S($P(X,"^",2)]"":$P(X,"^",2),1:$P(X,"^")),PSGLRN=$S(X'[",":X,1:$E(X,$F(X,","))_$E(X))
S:'PSGLRPH PSGLRPH="_____" I PSGLRPH,$D(^VA(200,+PSGLRPH,0))#2 S X=^(0),X=$S($P(X,"^",2)]"":$P(X,"^",2),1:$P(X,"^")),PSGLRPH=$S(X'[",":X,1:$E(X,$F(X,","))_$E(X))
I $P($G(^PS(51.2,+PSGLMR,0)),"^")]"" S PSGLMR=$E($S($P(^(0),"^",3)]"":$P(^(0),"^",3),1:$P(^(0),"^")),1,5)
I $P($G(^VA(200,+PSGLPR,0)),"^")]"" S PSGLPR=$P(^(0),"^")
S Q=32-$L(PSGLDO)-$L(PSGLMR) I $L(PSGLSCH)>Q S PSGLSCH=$E(PSGLSCH,1,Q-3)_"..."
NEW DRUGNAME
D DRGDISP^PSJLMUT1(DFN,$S(PSGORD["A":+PSGORD_"U",PSGORD["U":+PSGORD_"U",1:+PSGORD_"P"),40,34,.DRUGNAME,0)
; naked references below refer to full reference inside indirection @(F_"2)" for either file 53.1 or 55
N PSGNOW D NOW^%DTC S PSGNOW=% S (PSGLNF,PSGLWS)=0 F X=0:0 S X=$O(@(F_"1,"_X_")")) Q:'X!(PSGLWS) S Y=$G(^(X,0)) I $P(Y,U,3)>PSGNOW!'$P(Y,U,3) S PSGLWS=$S($D(^PSI(58.1,"D",+Y,+PSGLWD)):1,$D(^PSD(58.8,"D",+Y,+PSGLWD)):1,1:0)
I $D(PSGLSTOP) Q
;
ENP ;
I PSGLSD[" ",+$G(@(F_"4)")) S X="P E N D I N G"
E S X=$S(+$G(PSGLREN):PSGLREN,1:PSGLSD)_" |"_PSGLFD
W $C(13),?1,PSGLOD," |",X,?36,"(",PSGLBS5,")",?42,"|",PSGLAT(1),?52,PSGLPN,?88,$J($S(PSGLRB]"":PSGLRB,1:"*NF*"),12)
F X=0:0 S X=$O(DRUGNAME(X)) Q:'X D
. I X=1 W !?1,DRUGNAME(X),?42,PSGLST,?43,"|",PSGLAT(2),?52,PSGLSSN,?70,PSGLDOB," (",PSGLAGE,")",?85,$J($S(PSGLTM]"":PSGLTM,1:"NOT FOUND"),15)
. I X=2 W !?1,DRUGNAME(X),?43,"|",PSGLAT(3),?52,PSGLSEX,?65,"DX: ",PSGLDX
. S L=X+1
. I L=5,PSGLSI]"" W "See next label for continuation" D NXTLNE W !,?1
. I X>2 W !?1,DRUGNAME(X) D NXTLNE
I L=5,PSGLSI]"" W "See next label for continuation" D NXTLNE W !,?1
F Y=1:1:$L(PSGLSI," ") S Y1=$P(PSGLSI," ",Y) D
.I $L(Y1)>42 F Q:$L(Y1)<42 D
..S LEN=43-$X W $E(Y1,1,LEN) S Y1=$E(Y1,LEN+1,255) D NXTLNE
..I L#5=0 W "See next label for continuation" D NXTLNE W !,?1
.I ($X+$L(Y1))>42 D NXTLNE I L#5=0 W "See next label for continuation" D NXTLNE W !,?1
.W Y1," "
D:PSGLSI]"" NXTLNE
I $D(PSGLAT(L+1)) F Q:'$D(PSGLAT(L+1)) D
.I L#5=0 W ?1,"See next label for continuation" D NXTLNE W ! Q
.D NXTLNE
I L#5>0 F Q:L#5=0 D NXTLNE
W $E("WS",1,PSGLWS*2) W:PSGLSM ?4,$E("HSM",PSGLSM,3) W ?8,$E("NF",1,PSGLNF*2),?24,"RPH:",PSGLRPH,?33," RN:",PSGLRN D NXTLNE
W !
Q
;
NXTLNE ; Print info to right of drug
W ?43,"|",$G(PSGLAT(L))
I L=4 D
.N Y S Y=PSGLR W ?52 W:+$G(PSGLREN)!(PSGLSD) $S(+$G(PSGLREN):PSGLREN,1:PSGLSD),?77,$S(Y="NR":"RENEWAL ",Y["N":"NEW ",1:""),"ORDER "
.W $S(Y="E":"EDITED",Y="DE":"DC'ED (EDIT)",Y["D":"DISCONTINUED",Y="NE":"(EDIT)",PSGLR="H1":"ON HOLD",PSGLR="H0":"OFF OF HOLD",PSGLR="RE":"REINSTATED",1:"")
.I PSGLFFD]"",PSGLFFD'>PSGDT,PSGLR'["D" W " (EXPIRED)"
W:L=5 ?52,$S(PSGLWGN]"":$E(PSGLWGN,1,21),1:"NOT FOUND"),?79,$J($S(PSGLWDN]"":$E(PSGLWDN,1,21),1:"NOT FOUND"),21)
W !,?1 S L=L+1
Q
ENKV ;*** Kill var created from this routine
K PSGDT,PSGLAGE,PSGLAT,PSGLBS5,PSGLDDA,PSGLDO,PSGLDOB,PSGLDRG,PSGLDT,PSGLDX,PSGLFD,PSGLFFD,PSGLMN,PSGLMR,PSGLNF,PSGLOD,PSGLPN
K PSGLPR,PSGLR,PSGLRB,PSGLRN,PSGLRPH,PSGLSCH,PSGLSD,PSGLSEX,PSGLSI,PSGLSM,PSGLSSD,PSGLSSN,PSGLST
K PSGLSTAT,PSGLSTOP,PSGLTD,PSGLTM,PSGLWD,PSGLWDN,PSGLWGN,PSGLWS,PSGNOW,PSGOP,PSGORD
Q
PSGLOI ;BIR/CML3 - ORDER INFO (AND PRINT) FOR LABELS ;30 Apr 98 / 4:41 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**7,44,58,110,111,138,197**;16 DEC 97;Build 3
+2 ;
+3 ;Reference to ^PS(51.2 is supported by DBIA 2178.
+4 ;Reference to ^PSD(58.8 is supported by DBIA 2283.
+5 ;Reference to ^PSI(58.1 is supported by DBIA 2284.
+6 ;Reference to ^PS(55 supported by DBIA #2191.
+7 ;
ENOI ;
+1 SET F="^PS("_$SELECT(PSGORD["N":"53.1,",PSGORD["P":"53.1,",1:"55,"_PSGOP_",5,")_+PSGORD_","
+2 ; the quit below corrects an error if the Order has been moved to 55
+3 IF '$DATA(@(F_"0)"))
QUIT
+4 SET ND=$GET(@(F_"0)"))
SET PSGLPR=$PIECE(ND,"^",2)
SET PSGLMR=$PIECE(ND,"^",3)
SET PSGLST=$PIECE(ND,"^",7)
SET PSGLSTAT=$PIECE(ND,"^",9)
SET PSGLTD=$PIECE(ND,"^",12)
SET PSGLOD=$PIECE(ND,"^",14)
SET PSGLSM=$SELECT('$PIECE(ND,"^",5):0,$PIECE(ND,"^",6):1,1:2)
SET NG=$PIECE(ND,"^",22)
+5 SET ND=$GET(@(F_".2)"))
SET PSGLDRG=$PIECE(ND,"^")
SET PSGLDDA=+ND
SET PSGLDO=$PIECE(ND,"^",2)
+6 SET PSGCLN=$SELECT(F[53.1:$GET(@(F_"""DSS"")")),1:$GET(@(F_"8)")))
IF PSGCLN]""
SET PSGLWDN=$PIECE(^SC($PIECE(PSGCLN,"^"),0),"^")
+7 ;
SET ;
+1 ; naked references below refer to full reference inside indirection @(F_"2)" for either file 53.1 or 55
+2 KILL PSGLAT
SET ND=$GET(@(F_"2)"))
SET (PSGLSSD,PSGLSD)=$PIECE(ND,"^",2)
SET (PSGLFFD,PSGLFD)=$PIECE(ND,"^",4)
SET PSGLAT=$PIECE(ND,"^",5)
SET PSGLMN=$PIECE(ND,"^",6)
SET PSGLSCH=$PIECE(ND,"^")
SET ND=$GET(^(7))
SET PSGLDT=+ND
SET PSGLR=$PIECE(ND,"^",2)
+3 IF PSGLST'="R"
IF PSGLMN="D"
IF PSGLAT=""
SET PSGLAT=$EXTRACT($PIECE(PSGLSD,".",2)_"0000",1,4)
+4 IF PSGLAT
IF PSGLSCH["@"
SET PSGLSCH=$PIECE(PSGLSCH,"@")
+5 SET (PSGLAT(0),X)=0
IF PSGLFD]""
IF PSGLFD'>PSGDT
SET (PSGLAT(0),X)=5
SET (PSGLAT(1),PSGLAT(2),PSGLAT(4),PSGLAT(5))="****"
SET PSGLAT(3)=$SELECT(PSGLSTAT["D":"DC'D",1:"EX'D")
+6 IF '$TEST
IF $SELECT(PSGLSTAT="P":1,PSGLSTAT="U":1,PSGLST="OC":1,PSGLST="P":1,1:PSGLSCH["PRN")
SET PSGLAT=""
+7 IF '$TEST
IF PSGLAT
SET PSGLAT(0)=$LENGTH(PSGLAT,"-")
SET X=0
Begin DoDot:1
+8 FOR Q=1:1:5
SET PSGLAT(Q)=""
+9 SET Q=PSGLAT(0)
SET Y=PSGLAT
IF Q=1
SET PSGLAT(3)=$PIECE(Y,"-")
QUIT
+10 IF Q=2
SET PSGLAT(1)=$PIECE(Y,"-")
SET PSGLAT(5)=$PIECE(Y,"-",2)
QUIT
+11 IF Q=3
SET PSGLAT(1)=$PIECE(Y,"-")
SET PSGLAT(3)=$PIECE(Y,"-",2)
SET PSGLAT(5)=$PIECE(Y,"-",3)
QUIT
+12 FOR Q=1:1:PSGLAT(0)
SET X=X+1
SET PSGLAT(X)=$PIECE(PSGLAT,"-",Q)
IF PSGLAT(0)<4
SET X=X+1
IF Q<5
SET PSGLAT(X)=""
End DoDot:1
+13 IF X<5
FOR Q=X+1:1:5
IF '$GET(PSGLAT(Q))
SET PSGLAT(Q)=""
+14 IF $GET(DFN)
IF $GET(PSGORD)
NEW PSGLREN
SET PSGLREN=+$$LASTREN^PSJLMPRI(DFN,PSGORD)
+15 SET ND=$GET(@(F_"4)"))
SET PSGLRN=+ND
SET PSGLRPH=+$PIECE(ND,"^",3)
NEW PSGLRNDT
SET PSGLRNDT=$PIECE(ND,"^",2)
IF PSGLRNDT
IF $GET(PSGLREN)
IF $GET(PSGLREN)>PSGLRNDT
SET PSGLRN=0
+16 IF +$GET(PSGLREN)
SET PSGLREN=$$ENDTC^PSGMI(PSGLREN)
+17 IF NG
SET PSGLSI="*** NOT TO BE GIVEN ***"
+18 IF '$TEST
SET PSGLSI=$PIECE($GET(@(F_"6)")),"^")
IF PSGLSI]""
SET PSGLSI=$$ENSET^PSGSICHK(PSGLSI)
+19 ; naked references below refer to full reference inside indirection @(F_"2)" for either file 53.1 or 55
+20 IF PSGLSI=""
IF $PIECE(@(F_"0)"),U,9)="P"
IF $ORDER(@(F_"12,0)"))
SET X=0
FOR
SET X=$ORDER(@(F_"12,"_X_")"))
IF 'X
QUIT
SET Z=$GET(^(X,0))
SET Y=$LENGTH(PSGLSI)
IF Y+$LENGTH(Z)'>179
SET PSGLSI=PSGLSI_Z_" "
IF Y+$LENGTH(Z)>179
SET PSGLSI="SEE PROVIDER COMMENTS"
QUIT
+21 SET PSGLDT=$$ENDTC^PSGMI(PSGLDT)
SET PSGLOD=$EXTRACT($$ENDTC^PSGMI(PSGLOD),1,5)
+22 IF PSGLSTAT="P"!(PSGLSTAT="U")
SET PSGLSD=" "
SET PSGLFD=" "
SET PSGLST=" "
+23 IF '$TEST
SET PSGLSD=$$ENDTC1^PSGMI(PSGLSD)
SET PSGLSD=$EXTRACT(PSGLSD,1,5)_$EXTRACT(PSGLSD,9,14)
SET PSGLFD=$$ENDTC1^PSGMI(PSGLFD)
+24 IF 'PSGLRN
SET PSGLRN="_____"
IF PSGLRN
IF $DATA(^VA(200,+PSGLRN,0))#2
SET X=^(0)
SET X=$SELECT($PIECE(X,"^",2)]"":$PIECE(X,"^",2),1:$PIECE(X,"^"))
SET PSGLRN=$SELECT(X'[",":X,1:$EXTRACT(X,$FIND(X,","))_$EXTRACT(X))
+25 IF 'PSGLRPH
SET PSGLRPH="_____"
IF PSGLRPH
IF $DATA(^VA(200,+PSGLRPH,0))#2
SET X=^(0)
SET X=$SELECT($PIECE(X,"^",2)]"":$PIECE(X,"^",2),1:$PIECE(X,"^"))
SET PSGLRPH=$SELECT(X'[",":X,1:$EXTRACT(X,$FIND(X,","))_$EXTRACT(X))
+26 IF $PIECE($GET(^PS(51.2,+PSGLMR,0)),"^")]""
SET PSGLMR=$EXTRACT($SELECT($PIECE(^(0),"^",3)]"":$PIECE(^(0),"^",3),1:$PIECE(^(0),"^")),1,5)
+27 IF $PIECE($GET(^VA(200,+PSGLPR,0)),"^")]""
SET PSGLPR=$PIECE(^(0),"^")
+28 SET Q=32-$LENGTH(PSGLDO)-$LENGTH(PSGLMR)
IF $LENGTH(PSGLSCH)>Q
SET PSGLSCH=$EXTRACT(PSGLSCH,1,Q-3)_"..."
+29 NEW DRUGNAME
+30 DO DRGDISP^PSJLMUT1(DFN,$SELECT(PSGORD["A":+PSGORD_"U",PSGORD["U":+PSGORD_"U",1:+PSGORD_"P"),40,34,.DRUGNAME,0)
+31 ; naked references below refer to full reference inside indirection @(F_"2)" for either file 53.1 or 55
+32 NEW PSGNOW
DO NOW^%DTC
SET PSGNOW=%
SET (PSGLNF,PSGLWS)=0
FOR X=0:0
SET X=$ORDER(@(F_"1,"_X_")"))
IF 'X!(PSGLWS)
QUIT
SET Y=$GET(^(X,0))
IF $PIECE(Y,U,3)>PSGNOW!'$PIECE(Y,U,3)
SET PSGLWS=$SELECT($DATA(^PSI(58.1,"D",+Y,+PSGLWD)):1,$DATA(^PSD(58.8,"D",+Y,+PSGLWD)):1,1:0)
+33 IF $DATA(PSGLSTOP)
QUIT
+34 ;
ENP ;
+1 IF PSGLSD[" "
IF +$GET(@(F_"4)"))
SET X="P E N D I N G"
+2 IF '$TEST
SET X=$SELECT(+$GET(PSGLREN):PSGLREN,1:PSGLSD)_" |"_PSGLFD
+3 WRITE $CHAR(13),?1,PSGLOD," |",X,?36,"(",PSGLBS5,")",?42,"|",PSGLAT(1),?52,PSGLPN,?88,$JUSTIFY($SELECT(PSGLRB]"":PSGLRB,1:"*NF*"),12)
+4 FOR X=0:0
SET X=$ORDER(DRUGNAME(X))
IF 'X
QUIT
Begin DoDot:1
+5 IF X=1
WRITE !?1,DRUGNAME(X),?42,PSGLST,?43,"|",PSGLAT(2),?52,PSGLSSN,?70,PSGLDOB," (",PSGLAGE,")",?85,$JUSTIFY($SELECT(PSGLTM]"":PSGLTM,1:"NOT FOUND"),15)
+6 IF X=2
WRITE !?1,DRUGNAME(X),?43,"|",PSGLAT(3),?52,PSGLSEX,?65,"DX: ",PSGLDX
+7 SET L=X+1
+8 IF L=5
IF PSGLSI]""
WRITE "See next label for continuation"
DO NXTLNE
WRITE !,?1
+9 IF X>2
WRITE !?1,DRUGNAME(X)
DO NXTLNE
End DoDot:1
+10 IF L=5
IF PSGLSI]""
WRITE "See next label for continuation"
DO NXTLNE
WRITE !,?1
+11 FOR Y=1:1:$LENGTH(PSGLSI," ")
SET Y1=$PIECE(PSGLSI," ",Y)
Begin DoDot:1
+12 IF $LENGTH(Y1)>42
FOR
IF $LENGTH(Y1)<42
QUIT
Begin DoDot:2
+13 SET LEN=43-$X
WRITE $EXTRACT(Y1,1,LEN)
SET Y1=$EXTRACT(Y1,LEN+1,255)
DO NXTLNE
+14 IF L#5=0
WRITE "See next label for continuation"
DO NXTLNE
WRITE !,?1
End DoDot:2
+15 IF ($X+$LENGTH(Y1))>42
DO NXTLNE
IF L#5=0
WRITE "See next label for continuation"
DO NXTLNE
WRITE !,?1
+16 WRITE Y1," "
End DoDot:1
+17 IF PSGLSI]""
DO NXTLNE
+18 IF $DATA(PSGLAT(L+1))
FOR
IF '$DATA(PSGLAT(L+1))
QUIT
Begin DoDot:1
+19 IF L#5=0
WRITE ?1,"See next label for continuation"
DO NXTLNE
WRITE !
QUIT
+20 DO NXTLNE
End DoDot:1
+21 IF L#5>0
FOR
IF L#5=0
QUIT
DO NXTLNE
+22 WRITE $EXTRACT("WS",1,PSGLWS*2)
IF PSGLSM
WRITE ?4,$EXTRACT("HSM",PSGLSM,3)
WRITE ?8,$EXTRACT("NF",1,PSGLNF*2),?24,"RPH:",PSGLRPH,?33," RN:",PSGLRN
DO NXTLNE
+23 WRITE !
+24 QUIT
+25 ;
NXTLNE ; Print info to right of drug
+1 WRITE ?43,"|",$GET(PSGLAT(L))
+2 IF L=4
Begin DoDot:1
+3 NEW Y
SET Y=PSGLR
WRITE ?52
IF +$GET(PSGLREN)!(PSGLSD)
WRITE $SELECT(+$GET(PSGLREN):PSGLREN,1:PSGLSD),?77,$SELECT(Y="NR":"RENEWAL ",Y["N":"NEW ",1:""),"ORDER "
+4 WRITE $SELECT(Y="E":"EDITED",Y="DE":"DC'ED (EDIT)",Y["D":"DISCONTINUED",Y="NE":"(EDIT)",PSGLR="H1":"ON HOLD",PSGLR="H0":"OFF OF HOLD",PSGLR="RE":"REINSTATED",1:"")
+5 IF PSGLFFD]""
IF PSGLFFD'>PSGDT
IF PSGLR'["D"
WRITE " (EXPIRED)"
End DoDot:1
+6 IF L=5
WRITE ?52,$SELECT(PSGLWGN]"":$EXTRACT(PSGLWGN,1,21),1:"NOT FOUND"),?79,$JUSTIFY($SELECT(PSGLWDN]"":$EXTRACT(PSGLWDN,1,21),1:"NOT FOUND"),21)
+7 WRITE !,?1
SET L=L+1
+8 QUIT
ENKV ;*** Kill var created from this routine
+1 KILL PSGDT,PSGLAGE,PSGLAT,PSGLBS5,PSGLDDA,PSGLDO,PSGLDOB,PSGLDRG,PSGLDT,PSGLDX,PSGLFD,PSGLFFD,PSGLMN,PSGLMR,PSGLNF,PSGLOD,PSGLPN
+2 KILL PSGLPR,PSGLR,PSGLRB,PSGLRN,PSGLRPH,PSGLSCH,PSGLSD,PSGLSEX,PSGLSI,PSGLSM,PSGLSSD,PSGLSSN,PSGLST
+3 KILL PSGLSTAT,PSGLSTOP,PSGLTD,PSGLTM,PSGLWD,PSGLWDN,PSGLWGN,PSGLWS,PSGNOW,PSGOP,PSGORD
+4 QUIT
