- PSGVBWU ;BIR/CML3,MV-GET ORDERS FOR COMPLETE/VERIFY ; 7/21/08 8:18am
- ;;5.0; INPATIENT MEDICATIONS ;**3,44,47,67,58,110,111,196**;16 DEC 97;Build 13
- ;
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ;
- 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
- 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
- . 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
- S X1=$P(PSGDT,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1)
- W !!,"Searching for Pending and Non-Verified orders"
- F STAT="P","N","I" F DFN=0:0 S DFN=$O(^PS(53.1,"AS",STAT,DFN)) Q:'DFN D
- .W "." S PSJWG=$$WGNM($P($G(^DPT(DFN,.1)),U))
- .F ON=0:0 S ON=$O(^PS(53.1,"AS",STAT,DFN,ON)) Q:'ON D
- .. N OWG,A,CGN,CGNM
- ..;GMZ:PSJ*5*196;Display order totals on all clinic groups in which a clinic belongs.
- .. S OWG=PSJWG I PSJWG="ZZ",$D(^PS(53.1,ON,"DSS")) S A=^("DSS") D CGNM(A,OWG,.CGNM) D
- ... 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 Q
- ... 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
- .. Q:$G(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
- ;
- I '$D(^XTMP("PSJPVNV")) D
- .N PSJXR S PSJXR=$S(+PSJSYSU=3:"APV",1:"ANV") F DFN=0:0 S DFN=$O(^PS(55,PSJXR,DFN)) Q:'DFN D
- ..W "." D IN5^VADPT S PSJPAD=+VAIP(3) K VAIP F PSGORD=0:0 S PSGORD=$O(^PS(55,PSJXR,DFN,PSGORD)) Q:'PSGORD D
- ...S PSGST=$P($G(^PS(55,DFN,5,PSGORD,0)),U,7),PSGFD=$P($G(^(2)),U,4) I ((PSGST="O")&(PSJPAD>0)&(PSGFD>PSJPAD))!((PSGST'="O")&(PSGFD'<PSGODT)) I $$ECHK(DFN,PSGORD,PSGDT,PSGFD) S PSJWD=$P($G(^DPT(DFN,.1)),U) I PSJWD]"" D
- ....S PSJWG=$$WGNM(PSJWD)
- .... N OWG,A
- .... S OWG=PSJWG I PSJWG="ZZ",$D(^PS(55,DFN,5,PSGORD,8)) S A=^(8),PSJWG=$$CGNM(A,OWG)
- .... D CNTSET(PSJWG,4) S PSJWG=OWG
- .N PSJXR S PSJXR=$S(+PSJSYSU=3:"APIV",1:"ANIV") F DFN=0:0 S DFN=$O(^PS(55,PSJXR,DFN)) Q:'DFN D
- ..W "." D IN5^VADPT S PSJPAD=+VAIP(3) K VAIP F PSGORD=0:0 S PSGORD=$O(^PS(55,PSJXR,DFN,PSGORD)) Q:'PSGORD D
- ...S PSGFD=$P($G(^PS(55,DFN,"IV",PSGORD,0)),U,3) I $$ECHK2(DFN,PSGORD,PSGDT,PSGFD) S PSJWD=$P($G(^DPT(DFN,.1)),U) I PSJWD]"" D
- ....S PSJWG=$$WGNM(PSJWD)
- .... N OWG,A
- .... S OWG=PSJWG I PSJWG="ZZ",$D(^PS(55,DFN,"IV",PSGORD,"DSS")) S A=^("DSS"),PSJWG=$$CGNM(A,OWG)
- .... D CNTSET(PSJWG,3) S PSJWG=OWG
- I $D(^XTMP("PSJPVNV")) S PSJWD="" F S PSJWD=$O(^DPT("CN",PSJWD)) Q:PSJWD="" S PSJWG=$$WGNM(PSJWD) F DFN=0:0 S DFN=$O(^DPT("CN",PSJWD,DFN)) Q:'DFN D
- .; removed ref to ^DGPM
- .;S PSJPAD=9999999.9999999-$O(^DGPM("ATID1",DFN,0))
- .D IN5^VADPT S PSJPAD=+VAIP(3) K VAIP
- .W "."
- .F PSJST="C","O","OC","P","R" F PSGFD=$S(PSJST="O":PSJPAD,1:PSGODT):0 S PSGFD=$O(^PS(55,DFN,5,"AU",PSJST,PSGFD)) Q:'PSGFD D
- ..F PSGORD=0:0 S PSGORD=$O(^PS(55,DFN,5,"AU",PSJST,PSGFD,PSGORD)) Q:'PSGORD I $$ECHK(DFN,PSGORD,PSGDT,PSGFD) D
- ... N OWG,A
- ... S OWG=PSJWG I PSJWG="ZZ",$D(^PS(55,DFN,"IV",PSGORD,"DSS")) S A=^("DSS"),PSJWG=$$CGNM(A,OWG)
- ... D CNTSET(PSJWG,3) S PSJWG=OWG
- .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) D
- .. N OWG,A
- .. S OWG=PSJWG I PSJWG="ZZ",$D(^PS(55,DFN,"IV",PSGORD,"DSS")) S A=^("DSS"),PSJWG=$$CGNM(A,OWG)
- .. D CNTSET(PSJWG,3) S PSJWG=OWG
- ;
- 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 $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
- ;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
- PSGVBWU ;BIR/CML3,MV-GET ORDERS FOR COMPLETE/VERIFY ; 7/21/08 8:18am
- +1 ;;5.0; INPATIENT MEDICATIONS ;**3,44,47,67,58,110,111,196**;16 DEC 97;Build 13
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191.
- +4 ;
- 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 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
- Begin DoDot:1
- +3 IF (+PSJSYSU=1)&('$PIECE(ND4,U,+PSJSYSU))
- SET OK=1
- QUIT
- +4 IF (+PSJSYSU=3)&('$PIECE(ND4,U,+PSJSYSU+1))
- SET OK=1
- QUIT
- End DoDot:1
- +5 QUIT OK
- +6 ;
- 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
- +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 FOR STAT="P","N","I"
- FOR DFN=0:0
- SET DFN=$ORDER(^PS(53.1,"AS",STAT,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +6 WRITE "."
- SET PSJWG=$$WGNM($PIECE($GET(^DPT(DFN,.1)),U))
- +7 FOR ON=0:0
- SET ON=$ORDER(^PS(53.1,"AS",STAT,DFN,ON))
- IF 'ON
- QUIT
- Begin DoDot:2
- +8 NEW OWG,A,CGN,CGNM
- +9 ;GMZ:PSJ*5*196;Display order totals on all clinic groups in which a clinic belongs.
- +10 SET OWG=PSJWG
- IF PSJWG="ZZ"
- IF $DATA(^PS(53.1,ON,"DSS"))
- SET A=^("DSS")
- DO CGNM(A,OWG,.CGNM)
- Begin DoDot:3
- +11 IF '$DATA(CGNM)
- SET CGN=$PIECE(^SC(+A,0),"^")_"^C"
- SET PSJWG=$PIECE(^SC(+A,0),"^")_"^C"
- Begin DoDot:4
- +12 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
- QUIT
- End DoDot:4
- +13 SET PSJSQ=""
- FOR
- SET PSJSQ=$ORDER(CGNM(+A,PSJSQ))
- IF PSJSQ=""
- QUIT
- Begin DoDot:4
- +14 SET (PSJWG,CGN)=$PIECE(CGNM(+A,PSJSQ),"^",1)_"^CG"
- 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
- +15 IF $GET(CGN)]""
- QUIT
- 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:2
- End DoDot:1
- +16 ;
- +17 IF '$DATA(^XTMP("PSJPVNV"))
- Begin DoDot:1
- +18 NEW PSJXR
- SET PSJXR=$SELECT(+PSJSYSU=3:"APV",1:"ANV")
- FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,PSJXR,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +19 WRITE "."
- DO IN5^VADPT
- SET PSJPAD=+VAIP(3)
- KILL VAIP
- FOR PSGORD=0:0
- SET PSGORD=$ORDER(^PS(55,PSJXR,DFN,PSGORD))
- IF 'PSGORD
- QUIT
- Begin DoDot:3
- +20 SET PSGST=$PIECE($GET(^PS(55,DFN,5,PSGORD,0)),U,7)
- SET PSGFD=$PIECE($GET(^(2)),U,4)
- IF ((PSGST="O")&(PSJPAD>0)&(PSGFD>PSJPAD))!((PSGST'="O")&(PSGFD'<PSGODT))
- IF $$ECHK(DFN,PSGORD,PSGDT,PSGFD)
- SET PSJWD=$PIECE($GET(^DPT(DFN,.1)),U)
- IF PSJWD]""
- Begin DoDot:4
- +21 SET PSJWG=$$WGNM(PSJWD)
- +22 NEW OWG,A
- +23 SET OWG=PSJWG
- IF PSJWG="ZZ"
- IF $DATA(^PS(55,DFN,5,PSGORD,8))
- SET A=^(8)
- SET PSJWG=$$CGNM(A,OWG)
- +24 DO CNTSET(PSJWG,4)
- SET PSJWG=OWG
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +25 NEW PSJXR
- SET PSJXR=$SELECT(+PSJSYSU=3:"APIV",1:"ANIV")
- FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,PSJXR,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +26 WRITE "."
- DO IN5^VADPT
- SET PSJPAD=+VAIP(3)
- KILL VAIP
- FOR PSGORD=0:0
- SET PSGORD=$ORDER(^PS(55,PSJXR,DFN,PSGORD))
- IF 'PSGORD
- QUIT
- Begin DoDot:3
- +27 SET PSGFD=$PIECE($GET(^PS(55,DFN,"IV",PSGORD,0)),U,3)
- IF $$ECHK2(DFN,PSGORD,PSGDT,PSGFD)
- SET PSJWD=$PIECE($GET(^DPT(DFN,.1)),U)
- IF PSJWD]""
- Begin DoDot:4
- +28 SET PSJWG=$$WGNM(PSJWD)
- +29 NEW OWG,A
- +30 SET OWG=PSJWG
- IF PSJWG="ZZ"
- IF $DATA(^PS(55,DFN,"IV",PSGORD,"DSS"))
- SET A=^("DSS")
- SET PSJWG=$$CGNM(A,OWG)
- +31 DO CNTSET(PSJWG,3)
- SET PSJWG=OWG
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 IF $DATA(^XTMP("PSJPVNV"))
- SET PSJWD=""
- FOR
- SET PSJWD=$ORDER(^DPT("CN",PSJWD))
- IF PSJWD=""
- QUIT
- SET PSJWG=$$WGNM(PSJWD)
- FOR DFN=0:0
- SET DFN=$ORDER(^DPT("CN",PSJWD,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +33 ; removed ref to ^DGPM
- +34 ;S PSJPAD=9999999.9999999-$O(^DGPM("ATID1",DFN,0))
- +35 DO IN5^VADPT
- SET PSJPAD=+VAIP(3)
- KILL VAIP
- +36 WRITE "."
- +37 FOR PSJST="C","O","OC","P","R"
- FOR PSGFD=$SELECT(PSJST="O":PSJPAD,1:PSGODT):0
- SET PSGFD=$ORDER(^PS(55,DFN,5,"AU",PSJST,PSGFD))
- IF 'PSGFD
- QUIT
- Begin DoDot:2
- +38 FOR PSGORD=0:0
- SET PSGORD=$ORDER(^PS(55,DFN,5,"AU",PSJST,PSGFD,PSGORD))
- IF 'PSGORD
- QUIT
- IF $$ECHK(DFN,PSGORD,PSGDT,PSGFD)
- Begin DoDot:3
- +39 NEW OWG,A
- +40 SET OWG=PSJWG
- IF PSJWG="ZZ"
- IF $DATA(^PS(55,DFN,"IV",PSGORD,"DSS"))
- SET A=^("DSS")
- SET PSJWG=$$CGNM(A,OWG)
- +41 DO CNTSET(PSJWG,3)
- SET PSJWG=OWG
- End DoDot:3
- End DoDot:2
- +42 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)
- Begin DoDot:2
- +43 NEW OWG,A
- +44 SET OWG=PSJWG
- IF PSJWG="ZZ"
- IF $DATA(^PS(55,DFN,"IV",PSGORD,"DSS"))
- SET A=^("DSS")
- SET PSJWG=$$CGNM(A,OWG)
- +45 DO CNTSET(PSJWG,3)
- SET PSJWG=OWG
- End DoDot:2
- End DoDot:1
- +46 ;
- 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 IF $PIECE(WG,"^",2)=""
- SET $PIECE(^TMP("PSJ",$JOB,"WG",WG),U,X)=$PIECE($GET(^TMP("PSJ",$JOB,"WG",WG)),U,X)+1
- QUIT
- +4 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
- +5 QUIT
- +6 ;
- 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 NEW B,CGN
- +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
