PSGVBWU ;BIR/CML3,MV-GET ORDERS FOR COMPLETE/VERIFY ; 6/2/10 10:44am
;;5.0;INPATIENT MEDICATIONS;**3,44,47,67,58,110,111,196,241,422**;DEC 16, 1997;Build 9
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^PS(51.1 is supported by DBIA #2177
;
ECHK(DFN,O,DT,SD) ;
N OK S OK=0
I $P($G(^PS(55,DFN,5,O,0)),U,9)'["D" S ND=$G(^(0)) Q:ND="" 0 S ND4=$G(^(4)) D
.;I "DE"'[$P($G(^PS(55,DFN,5,O,0)),U,9) S ND=$G(^(0)) Q:ND="" 0 S ND4=$G(^(4)) D
.I $S(SD>PSGDT:$S(ND="":1,'$P(ND4,U,$S(PSJSYSU:PSJSYSU,1:1)):1,$P(ND4,U,13):1,$P(ND4,U,19):1,$P(ND4,U,23):1,1:$P(ND4,U,16)),$P(ND,U,7)="O":$S(ND4="":1,1:'$P(ND4,U,$S(PSJSYSU:PSJSYSU,1:1))),1:$P(ND4,U,16)) S OK=1
Q OK
ECHK2(DFN,O,DT,SD) ;
N OK S OK=0
;*PSJ*5*241: Include one-time IV orders
N SCH,STYPE S STYPE=0,SCH=$P($G(^PS(55,DFN,"IV",O,0)),U,9)
S:SCH]"" SCH=$O(^PS(51.1,"APPSJ",SCH,STYPE)) S:SCH]"" STYPE=$P(^PS(51.1,SCH,0),U,5)
I $P($G(^PS(55,DFN,"IV",O,0)),U,17)'["D" S ND=$G(^(0)) Q:ND="" 0 S ND4=$G(^(4)) D:(SD>PSGDT)!((SD>PSJPAD)&($G(STYPE)="O"))
. I (+PSJSYSU=1)&('$P(ND4,U,+PSJSYSU)) S OK=1 Q
. I (+PSJSYSU=3)&('$P(ND4,U,+PSJSYSU+1)) S OK=1 Q
Q OK
;
SET ;
I ON["P",$G(PSJCOM)]"",$G(PRNTON)=+PSJCOM Q
I ON["P",$G(PSJCOM)]"" S PRNTON=+PSJCOM,ON=+PSJCOM
S PSJPRIO=$S($G(PSJPRIO)="S":"A",1:"Z"),^TMP("PSJON",$J,PSJPRIO,LD_U_ON)=""
Q
;
CNTORDRS ; Display # pending orders by type and ward group
K ^TMP("PSJ",$J) D:$G(IOST(0)) ENS^%ZISS
N DFN,DIRUT,ON,TYP,PSGODT,PSJWD,PSJWG,X,X1,X2,OWG,A,CGN,CGNM,PSJPCNT
S X1=$P(PSGDT,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1)
W !!,"Searching for Pending and Non-Verified orders"
;PSJ*5*422 adjust to count clinic orders separate from inpatient ward orders
S PSJPCNT=0
F STAT="P","N","I" F DFN=0:0 S DFN=$O(^PS(53.1,"AS",STAT,DFN)) Q:'DFN D
.S PSJPCNT=PSJPCNT+1 W:PSJPCNT#25=0 "."
.F ON=0:0 S ON=$O(^PS(53.1,"AS",STAT,DFN,ON)) Q:'ON D
.. S PSJWG="" I $G(^PS(53.1,ON,"DSS")) S PSJWG="ZZ" ;Clinical Med order?
.. S CGN="" K CGNM ;PSJ*5*422 CGNM needs to be reinitialized
..;GMZ:PSJ*5*196;Display order totals on all clinic groups in which a clinic belongs.
.. S OWG=PSJWG I PSJWG="ZZ" D
... ;Clinical location counts:
... S A=^PS(53.1,ON,"DSS") D CGNM(A,OWG,.CGNM)
... I '$D(CGNM) S CGN=$P(^SC(+A,0),"^")_"^C",PSJWG=$P(^SC(+A,0),"^")_"^C" D
....I CGN]"" S TYP=$P($G(^PS(53.1,ON,0)),U,4),OTYP=$S((STAT="P")&(TYP="F"):1,(STAT="P")&(TYP="I"):1,(STAT="P")&(TYP="U"):2,TYP="F":3,TYP="I":3,1:4) D CNTSET(PSJWG,OTYP) S PSJWG=OWG
... S PSJSQ="" F S PSJSQ=$O(CGNM(+A,PSJSQ)) Q:PSJSQ="" D
.... S (PSJWG,CGN)=$P(CGNM(+A,PSJSQ),"^",1)_"^CG"
.... I CGN]"" S TYP=$P($G(^PS(53.1,ON,0)),U,4),OTYP=$S((STAT="P")&(TYP="F"):1,(STAT="P")&(TYP="I"):1,(STAT="P")&(TYP="U"):2,TYP="F":3,TYP="I":3,1:4) D CNTSET(PSJWG,OTYP) S PSJWG=OWG
.. ;Ward Counts:
.. Q:$G(CGN)]""
.. S PSJWG=$$WGNM($P($G(^DPT(DFN,.1)),U)),TYP=$P($G(^PS(53.1,ON,0)),U,4)
.. S OTYP=$S((STAT="P")&(TYP="F"):1,(STAT="P")&(TYP="I"):1,(STAT="P")&(TYP="U"):2,TYP="F":3,TYP="I":3,1:4)
.. D CNTSET(PSJWG,OTYP) S PSJWG=OWG
;PSJ*5.0*422: Deleted logic searching file 55 since the subscripts
; searched do not apply to pending/non-verified orders.
; The additional unneeded searches caused sessions to
; hang at sites until the searches completed.
DISPLAY ;
N H,I
D CNTHEAD I '$D(^TMP("PSJ",$J)) W ?21,"No pending/non-verified orders found.",! Q
S H("WG")="Ward Groups",H("CG")="Clinic Groups",H("C")="Clinics"
F I="WG","CG","C" I $D(^TMP("PSJ",$J,I)) D
. I I'="CG" W !,H(I),!!
. I I="CG" W !,H(I),?13,"- The same order may be listed under more than 1 Clinic Group;",!,?15,"Therefore sum of Orders listed may not match total number of",!,?15,"pending orders. ",!!
. S WG="" F S WG=$O(^TMP("PSJ",$J,I,WG)) Q:WG=""!$D(DIRUT) S X=$G(^(WG)) D
.. ;W $S(WG="ZZ":"^OTHER",1:WG),?30,$J(+X,6),?44,$J(+$P(X,U,2),6),?58,$J(+$P(X,U,3),6),?72,$J(+$P(X,U,4),6),!
.. W $S(WG="ZZ":"^OTHER",1:WG),?26,$J(+X,6),?36,$J(+$P(X,U,2),6),?51,$J(+$P(X,U,3),6),?63,$J(+$P(X,U,4),6),!
.. I $Y>(IOSL-2) N DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT) D CNTHEAD
Q
CNTSET(WG,X) ; Update counters for ward group totals
; Input: WG - Ward Group IEN
; X - piece identifying order type.
;I WG="C WARD",X=1 B
I $P(WG,"^",2)="" S $P(^TMP("PSJ",$J,"WG",WG),U,X)=$P($G(^TMP("PSJ",$J,"WG",WG)),U,X)+1 Q
I $P(WG,"^",2)]"" S $P(^TMP("PSJ",$J,$P(WG,"^",2),$P(WG,"^")),U,X)=$P($G(^TMP("PSJ",$J,$P(WG,"^",2),$P(WG,"^"))),U,X)+1 Q
Q
;
WGNM(WD) ; DETERMINE WARD GROUP NAME
N WG
I WD]"" S WG=+$O(^PS(57.5,"AB",+$O(^DIC(42,"B",WD,0)),0)),WG=$P($G(^PS(57.5,WG,0)),U)
S:$G(WG)="" WG="ZZ"
Q WG
;
CGNM(A,WGN,CGNM) ;DETERMINE CLINIC GROUP NAME
N B ;,CGN PSJ*5*422 CGN should not be newed
;I $P(A,"^",2)="" Q WGN
S (B,CGN)="" F S B=$O(^PS(57.8,"AC",+A,B)) Q:B="" D
. S CGNM(+A,B)=$P(^PS(57.8,B,0),"^")
I $P(CGN,"^")="" S CGN=$P(^SC(+A,0),"^")_"^C"
Q
;
CNTHEAD ; Header for order count.
;W @IOF,!,?16,"Pending/Non-Verified Order Totals by Ward Group",!!,?29,"Pending",?43,"Pending",?57,"Pending",!
;W "Ward Group",?30,"Fluids",?48,"IV",?55,"Unit Dose",?66,"Non-Verified",!!
W @IOF,!,?16,"Pending/Non-Verified Order Totals by Ward Group/Clinic Location",!!,?33,"Pending",?56,"Non-Verified",!
W "Ward Group/Clinic Location",?30,"IV",?40,"UD",?55,"IV",?67,"UD",!
Q
;
ENGORD ; get and sort order
N PSJCOM,PRNTON
D NOW^%DTC S PSGDT=+$E(%,1,12),X1=$P(%,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1),HDT=$$ENDTC^PSGMI(PSGDT),UDU=$P(PSJSYSU,";",3)>1 K ^TMP("PSJON",$J)
W !!,"...a few moments, please..."
I PSJTOO'=2 F PSGO2=+PSJPAD:0 S PSGO2=$O(^PS(55,PSGP,5,"AUS",PSGO2)) Q:'PSGO2 Q:PSGO2>PSGDT F PSGO3=0:0 S PSGO3=$O(^PS(55,PSGP,5,"AUS",PSGO2,PSGO3)) Q:'PSGO3 I $D(^PS(55,PSGP,5,PSGO3,0)) S PSGO4=^(0) I "DEH"'[$E($P(PSGO4,"^",9)) D ENUH
K PSGO1,PSGO2,PSGO3,PSGO4
I PSJTOO'=1 F SD="I","P" F O=0:0 S O=$O(^PS(53.1,"AS",SD,PSGP,O)) Q:'O D
.S ND=$G(^PS(53.1,O,0)),PSJPRIO=$P($G(^(.2)),U,4),PSJCOM=$P($G(^(.2)),U,8),LD=$P($G(^PS(53.1,O,0)),U,16),ON=O_"P"
.I $S(PSJPAC=3:1,PSJPAC=1&($P(ND,U,4)="U"):1,PSJPAC=2&($P(ND,U,4)'="U"):1,+$P(ND,U,13)&$G(PSJRNF):1,+$P(ND,U,13)&$G(PSJIRNF):1,1:0) D SET
Q:PSJTOO=2
F ST="C","O","OC","P","R" F SD=+PSJPAD:0 S SD=$O(^PS(55,PSGP,5,"AU",ST,SD)) Q:'SD F O=0:0 S O=$O(^PS(55,PSGP,5,"AU",ST,SD,O)) Q:'O S ON=O_"U" I $$ECHK(PSGP,O,PSGDT,SD) S LD=$P($G(^PS(55,PSGP,5,O,0)),U,16) D SET
F O=0:0 S O=$O(^PS(53.1,"AS","N",PSGP,O)) Q:'O S LD=$P($G(^PS(53.1,O,0)),U,16),PSJCOM=$P($G(^(.2)),U,8) S ON=O_"P" D SET
F SD=+PSJPAD:0 S SD=$O(^PS(55,PSGP,"IV","AIS",SD)) Q:'SD F O=0:0 S O=$O(^PS(55,PSGP,"IV","AIS",SD,O)) Q:'O S ON=O_"V" I $$ECHK2(PSGP,O,PSGDT,SD) S LD=$P($G(^PS(55,PSGP,"IV",O,2)),U) D SET
Q
;
ENUH ;
S $P(^PS(55,PSGP,5,PSGO3,0),"^",9)="E" D EN1^PSJHL2(PSGP,"SC",PSGO3_"U")
Q
GOTOP ; Skip to a specific patient in list.
I '$$HIDDEN^PSJLMUTL("JUMP") S VALMBCK="R" Q
K PSJGOTO,DIR S DIR(0)="SM^J:Jump to a specific patient;E:Exit",DIR("A")="Select Action: ",DIR("B")="Exit" D ^DIR
Q:"JE"'[Y
I Y="E" S PSJGOTO=Y Q
K DIR S DIR(0)="PO^2:AEMQZ",DIR("S")="I $P(^(0),U)]"""",$D(^TMP(""PSJSELECT"",$J,""B"",$P(^(0),U)))",DIR("??")="^D GOTOPH^PSGVBWU" D ^DIR I Y<0 S PSGTOTO=Y Q
S VALMBCK="R",PSJGOTO=$S($P(Y,U,2)="":"E",1:$O(^TMP("PSJSELECT",$J,"B",$P(Y,U,2),0)))
Q
;
GOTOPH ;
F X=0:0 S X=$O(^TMP("PSJSELECT",$J,X)) Q:'X W !,$P($G(^TMP("PSJSELECT",$J,X)),U) I X#IOSL=0 N DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)
Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGVBWU 7492 printed Sep 23, 2025@19:39:34 Page 2
PSGVBWU ;BIR/CML3,MV-GET ORDERS FOR COMPLETE/VERIFY ; 6/2/10 10:44am
+1 ;;5.0;INPATIENT MEDICATIONS;**3,44,47,67,58,110,111,196,241,422**;DEC 16, 1997;Build 9
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to ^PS(51.1 is supported by DBIA #2177
+5 ;
ECHK(DFN,O,DT,SD) ;
+1 NEW OK
SET OK=0
+2 IF $PIECE($GET(^PS(55,DFN,5,O,0)),U,9)'["D"
SET ND=$GET(^(0))
if ND=""
QUIT 0
SET ND4=$GET(^(4))
Begin DoDot:1
+3 ;I "DE"'[$P($G(^PS(55,DFN,5,O,0)),U,9) S ND=$G(^(0)) Q:ND="" 0 S ND4=$G(^(4)) D
+4 IF $SELECT(SD>PSGDT:$SELECT(ND="":1,'$PIECE(ND4,U,$SELECT(PSJSYSU:PSJSYSU,1:1)):1,$PIECE(ND4,U,13):1,$PIECE(ND4,U,19):1,$PIECE(ND4,U,23):1,1:$PIECE(ND4,U,16)),$PIECE(ND,U,7)="O":$SELECT(ND4="":1,1:'$PIECE(ND4,U,...
... $SELECT(PSJSYSU:PSJSYSU,1:1))),1:$PIECE(ND4,U,16))
SET OK=1
End DoDot:1
+5 QUIT OK
ECHK2(DFN,O,DT,SD) ;
+1 NEW OK
SET OK=0
+2 ;*PSJ*5*241: Include one-time IV orders
+3 NEW SCH,STYPE
SET STYPE=0
SET SCH=$PIECE($GET(^PS(55,DFN,"IV",O,0)),U,9)
+4 if SCH]""
SET SCH=$ORDER(^PS(51.1,"APPSJ",SCH,STYPE))
if SCH]""
SET STYPE=$PIECE(^PS(51.1,SCH,0),U,5)
+5 IF $PIECE($GET(^PS(55,DFN,"IV",O,0)),U,17)'["D"
SET ND=$GET(^(0))
if ND=""
QUIT 0
SET ND4=$GET(^(4))
if (SD>PSGDT)!((SD>PSJPAD)&($GET(STYPE)="O"))
Begin DoDot:1
+6 IF (+PSJSYSU=1)&('$PIECE(ND4,U,+PSJSYSU))
SET OK=1
QUIT
+7 IF (+PSJSYSU=3)&('$PIECE(ND4,U,+PSJSYSU+1))
SET OK=1
QUIT
End DoDot:1
+8 QUIT OK
+9 ;
SET ;
+1 IF ON["P"
IF $GET(PSJCOM)]""
IF $GET(PRNTON)=+PSJCOM
QUIT
+2 IF ON["P"
IF $GET(PSJCOM)]""
SET PRNTON=+PSJCOM
SET ON=+PSJCOM
+3 SET PSJPRIO=$SELECT($GET(PSJPRIO)="S":"A",1:"Z")
SET ^TMP("PSJON",$JOB,PSJPRIO,LD_U_ON)=""
+4 QUIT
+5 ;
CNTORDRS ; Display # pending orders by type and ward group
+1 KILL ^TMP("PSJ",$JOB)
if $GET(IOST(0))
DO ENS^%ZISS
+2 NEW DFN,DIRUT,ON,TYP,PSGODT,PSJWD,PSJWG,X,X1,X2,OWG,A,CGN,CGNM,PSJPCNT
+3 SET X1=$PIECE(PSGDT,".")
SET X2=-2
DO C^%DTC
SET PSGODT=X_(PSGDT#1)
+4 WRITE !!,"Searching for Pending and Non-Verified orders"
+5 ;PSJ*5*422 adjust to count clinic orders separate from inpatient ward orders
+6 SET PSJPCNT=0
+7 FOR STAT="P","N","I"
FOR DFN=0:0
SET DFN=$ORDER(^PS(53.1,"AS",STAT,DFN))
if 'DFN
QUIT
Begin DoDot:1
+8 SET PSJPCNT=PSJPCNT+1
if PSJPCNT#25=0
WRITE "."
+9 FOR ON=0:0
SET ON=$ORDER(^PS(53.1,"AS",STAT,DFN,ON))
if 'ON
QUIT
Begin DoDot:2
+10 ;Clinical Med order?
SET PSJWG=""
IF $GET(^PS(53.1,ON,"DSS"))
SET PSJWG="ZZ"
+11 ;PSJ*5*422 CGNM needs to be reinitialized
SET CGN=""
KILL CGNM
+12 ;GMZ:PSJ*5*196;Display order totals on all clinic groups in which a clinic belongs.
+13 SET OWG=PSJWG
IF PSJWG="ZZ"
Begin DoDot:3
+14 ;Clinical location counts:
+15 SET A=^PS(53.1,ON,"DSS")
DO CGNM(A,OWG,.CGNM)
+16 IF '$DATA(CGNM)
SET CGN=$PIECE(^SC(+A,0),"^")_"^C"
SET PSJWG=$PIECE(^SC(+A,0),"^")_"^C"
Begin DoDot:4
+17 IF CGN]""
SET TYP=$PIECE($GET(^PS(53.1,ON,0)),U,4)
SET OTYP=$SELECT((STAT="P")&(TYP="F"):1,(STAT="P")&(TYP="I"):1,(STAT="P")&(TYP="U"):2,TYP="F":3,TYP="I":3,1:4)
DO CNTSET(PSJWG,OTYP)
SET PSJWG=OWG
End DoDot:4
+18 SET PSJSQ=""
FOR
SET PSJSQ=$ORDER(CGNM(+A,PSJSQ))
if PSJSQ=""
QUIT
Begin DoDot:4
+19 SET (PSJWG,CGN)=$PIECE(CGNM(+A,PSJSQ),"^",1)_"^CG"
+20 IF CGN]""
SET TYP=$PIECE($GET(^PS(53.1,ON,0)),U,4)
SET OTYP=$SELECT((STAT="P")&(TYP="F"):1,(STAT="P")&(TYP="I"):1,(STAT="P")&(TYP="U"):2,TYP="F":3,TYP="I":3,1:4)
DO CNTSET(PSJWG,OTYP)
SET PSJWG=OWG
End DoDot:4
End DoDot:3
+21 ;Ward Counts:
+22 if $GET(CGN)]""
QUIT
+23 SET PSJWG=$$WGNM($PIECE($GET(^DPT(DFN,.1)),U))
SET TYP=$PIECE($GET(^PS(53.1,ON,0)),U,4)
+24 SET OTYP=$SELECT((STAT="P")&(TYP="F"):1,(STAT="P")&(TYP="I"):1,(STAT="P")&(TYP="U"):2,TYP="F":3,TYP="I":3,1:4)
+25 DO CNTSET(PSJWG,OTYP)
SET PSJWG=OWG
End DoDot:2
End DoDot:1
+26 ;PSJ*5.0*422: Deleted logic searching file 55 since the subscripts
+27 ; searched do not apply to pending/non-verified orders.
+28 ; The additional unneeded searches caused sessions to
+29 ; hang at sites until the searches completed.
DISPLAY ;
+1 NEW H,I
+2 DO CNTHEAD
IF '$DATA(^TMP("PSJ",$JOB))
WRITE ?21,"No pending/non-verified orders found.",!
QUIT
+3 SET H("WG")="Ward Groups"
SET H("CG")="Clinic Groups"
SET H("C")="Clinics"
+4 FOR I="WG","CG","C"
IF $DATA(^TMP("PSJ",$JOB,I))
Begin DoDot:1
+5 IF I'="CG"
WRITE !,H(I),!!
+6 IF I="CG"
WRITE !,H(I),?13,"- The same order may be listed under more than 1 Clinic Group;",!,?15,"Therefore sum of Orders listed may not match total number of",!,?15,"pending orders. ",!!
+7 SET WG=""
FOR
SET WG=$ORDER(^TMP("PSJ",$JOB,I,WG))
if WG=""!$DATA(DIRUT)
QUIT
SET X=$GET(^(WG))
Begin DoDot:2
+8 ;W $S(WG="ZZ":"^OTHER",1:WG),?30,$J(+X,6),?44,$J(+$P(X,U,2),6),?58,$J(+$P(X,U,3),6),?72,$J(+$P(X,U,4),6),!
+9 WRITE $SELECT(WG="ZZ":"^OTHER",1:WG),?26,$JUSTIFY(+X,6),?36,$JUSTIFY(+$PIECE(X,U,2),6),?51,$JUSTIFY(+$PIECE(X,U,3),6),?63,$JUSTIFY(+$PIECE(X,U,4),6),!
+10 IF $Y>(IOSL-2)
NEW DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
QUIT
DO CNTHEAD
End DoDot:2
End DoDot:1
+11 QUIT
CNTSET(WG,X) ; Update counters for ward group totals
+1 ; Input: WG - Ward Group IEN
+2 ; X - piece identifying order type.
+3 ;I WG="C WARD",X=1 B
+4 IF $PIECE(WG,"^",2)=""
SET $PIECE(^TMP("PSJ",$JOB,"WG",WG),U,X)=$PIECE($GET(^TMP("PSJ",$JOB,"WG",WG)),U,X)+1
QUIT
+5 IF $PIECE(WG,"^",2)]""
SET $PIECE(^TMP("PSJ",$JOB,$PIECE(WG,"^",2),$PIECE(WG,"^")),U,X)=$PIECE($GET(^TMP("PSJ",$JOB,$PIECE(WG,"^",2),$PIECE(WG,"^"))),U,X)+1
QUIT
+6 QUIT
+7 ;
WGNM(WD) ; DETERMINE WARD GROUP NAME
+1 NEW WG
+2 IF WD]""
SET WG=+$ORDER(^PS(57.5,"AB",+$ORDER(^DIC(42,"B",WD,0)),0))
SET WG=$PIECE($GET(^PS(57.5,WG,0)),U)
+3 if $GET(WG)=""
SET WG="ZZ"
+4 QUIT WG
+5 ;
CGNM(A,WGN,CGNM) ;DETERMINE CLINIC GROUP NAME
+1 ;,CGN PSJ*5*422 CGN should not be newed
NEW B
+2 ;I $P(A,"^",2)="" Q WGN
+3 SET (B,CGN)=""
FOR
SET B=$ORDER(^PS(57.8,"AC",+A,B))
if B=""
QUIT
Begin DoDot:1
+4 SET CGNM(+A,B)=$PIECE(^PS(57.8,B,0),"^")
End DoDot:1
+5 IF $PIECE(CGN,"^")=""
SET CGN=$PIECE(^SC(+A,0),"^")_"^C"
+6 QUIT
+7 ;
CNTHEAD ; Header for order count.
+1 ;W @IOF,!,?16,"Pending/Non-Verified Order Totals by Ward Group",!!,?29,"Pending",?43,"Pending",?57,"Pending",!
+2 ;W "Ward Group",?30,"Fluids",?48,"IV",?55,"Unit Dose",?66,"Non-Verified",!!
+3 WRITE @IOF,!,?16,"Pending/Non-Verified Order Totals by Ward Group/Clinic Location",!!,?33,"Pending",?56,"Non-Verified",!
+4 WRITE "Ward Group/Clinic Location",?30,"IV",?40,"UD",?55,"IV",?67,"UD",!
+5 QUIT
+6 ;
ENGORD ; get and sort order
+1 NEW PSJCOM,PRNTON
+2 DO NOW^%DTC
SET PSGDT=+$EXTRACT(%,1,12)
SET X1=$PIECE(%,".")
SET X2=-2
DO C^%DTC
SET PSGODT=X_(PSGDT#1)
SET HDT=$$ENDTC^PSGMI(PSGDT)
SET UDU=$PIECE(PSJSYSU,";",3)>1
KILL ^TMP("PSJON",$JOB)
+3 WRITE !!,"...a few moments, please..."
+4 IF PSJTOO'=2
FOR PSGO2=+PSJPAD:0
SET PSGO2=$ORDER(^PS(55,PSGP,5,"AUS",PSGO2))
if 'PSGO2
QUIT
if PSGO2>PSGDT
QUIT
FOR PSGO3=0:0
SET PSGO3=$ORDER(^PS(55,PSGP,5,"AUS",PSGO2,PSGO3))
if 'PSGO3
QUIT
IF $DATA(^PS(55,PSGP,5,PSGO3,0))
SET PSGO4=^(0)
IF "DEH"'[$EXTRACT($PIECE(PSGO4,"^",9))
DO ENUH
+5 KILL PSGO1,PSGO2,PSGO3,PSGO4
+6 IF PSJTOO'=1
FOR SD="I","P"
FOR O=0:0
SET O=$ORDER(^PS(53.1,"AS",SD,PSGP,O))
if 'O
QUIT
Begin DoDot:1
+7 SET ND=$GET(^PS(53.1,O,0))
SET PSJPRIO=$PIECE($GET(^(.2)),U,4)
SET PSJCOM=$PIECE($GET(^(.2)),U,8)
SET LD=$PIECE($GET(^PS(53.1,O,0)),U,16)
SET ON=O_"P"
+8 IF $SELECT(PSJPAC=3:1,PSJPAC=1&($PIECE(ND,U,4)="U"):1,PSJPAC=2&($PIECE(ND,U,4)'="U"):1,+$PIECE(ND,U,13)&$GET(PSJRNF):1,+$PIECE(ND,U,13)&$GET(PSJIRNF):1,1:0)
DO SET
End DoDot:1
+9 if PSJTOO=2
QUIT
+10 FOR ST="C","O","OC","P","R"
FOR SD=+PSJPAD:0
SET SD=$ORDER(^PS(55,PSGP,5,"AU",ST,SD))
if 'SD
QUIT
FOR O=0:0
SET O=$ORDER(^PS(55,PSGP,5,"AU",ST,SD,O))
if 'O
QUIT
SET ON=O_"U"
IF $$ECHK(PSGP,O,PSGDT,SD)
SET LD=$PIECE($GET(^PS(55,PSGP,5,O,0)),U,16)
DO SET
+11 FOR O=0:0
SET O=$ORDER(^PS(53.1,"AS","N",PSGP,O))
if 'O
QUIT
SET LD=$PIECE($GET(^PS(53.1,O,0)),U,16)
SET PSJCOM=$PIECE($GET(^(.2)),U,8)
SET ON=O_"P"
DO SET
+12 FOR SD=+PSJPAD:0
SET SD=$ORDER(^PS(55,PSGP,"IV","AIS",SD))
if 'SD
QUIT
FOR O=0:0
SET O=$ORDER(^PS(55,PSGP,"IV","AIS",SD,O))
if 'O
QUIT
SET ON=O_"V"
IF $$ECHK2(PSGP,O,PSGDT,SD)
SET LD=$PIECE($GET(^PS(55,PSGP,"IV",O,2)),U)
DO SET
+13 QUIT
+14 ;
ENUH ;
+1 SET $PIECE(^PS(55,PSGP,5,PSGO3,0),"^",9)="E"
DO EN1^PSJHL2(PSGP,"SC",PSGO3_"U")
+2 QUIT
GOTOP ; Skip to a specific patient in list.
+1 IF '$$HIDDEN^PSJLMUTL("JUMP")
SET VALMBCK="R"
QUIT
+2 KILL PSJGOTO,DIR
SET DIR(0)="SM^J:Jump to a specific patient;E:Exit"
SET DIR("A")="Select Action: "
SET DIR("B")="Exit"
DO ^DIR
+3 if "JE"'[Y
QUIT
+4 IF Y="E"
SET PSJGOTO=Y
QUIT
+5 KILL DIR
SET DIR(0)="PO^2:AEMQZ"
SET DIR("S")="I $P(^(0),U)]"""",$D(^TMP(""PSJSELECT"",$J,""B"",$P(^(0),U)))"
SET DIR("??")="^D GOTOPH^PSGVBWU"
DO ^DIR
IF Y<0
SET PSGTOTO=Y
QUIT
+6 SET VALMBCK="R"
SET PSJGOTO=$SELECT($PIECE(Y,U,2)="":"E",1:$ORDER(^TMP("PSJSELECT",$JOB,"B",$PIECE(Y,U,2),0)))
+7 QUIT
+8 ;
GOTOPH ;
+1 FOR X=0:0
SET X=$ORDER(^TMP("PSJSELECT",$JOB,X))
if 'X
QUIT
WRITE !,$PIECE($GET(^TMP("PSJSELECT",$JOB,X)),U)
IF X#IOSL=0
NEW DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
QUIT
+2 QUIT
+3 QUIT
