| 1 | PSJLMHED ;BIR/MLM-BUILD LM HEADERS ;28 Jan 98 / 2:18 PM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**4,58,85,110,148**;16 DEC 97;Build 2
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
---|
| 5 | ; Reference to CWAD^ORQPT2 is supported by DBIA 2831.
|
---|
| 6 | ; Reference to ^SC is supported by DBIA 10040.
|
---|
| 7 | ;
|
---|
| 8 | HDR(DFN) ; -- list screen header
|
---|
| 9 | ; input: DFN := ifn of pat
|
---|
| 10 | ; output: VALMHDR() := hdr array
|
---|
| 11 | ;
|
---|
| 12 | K VAIN,VADM,GMRA,PSJACNWP,PSJ,VAERR,VA,X
|
---|
| 13 | S PSJACNWP=1 D ENBOTH^PSJAC
|
---|
| 14 | D HDRO(DFN)
|
---|
| 15 | S PSJ=" Sex: "_$P(PSJPSEX,U,2),VALMHDR(4)=$$SETSTR^VALM1($S(PSJPDD:"Last ",1:" ")_"Admitted: "_$P(PSJPAD,U,2),PSJ,45,23)
|
---|
| 16 | S PSJ=" Dx: "_PSJPDX
|
---|
| 17 | S:PSJPDD VALMHDR(5)=$$SETSTR^VALM1("Discharged: "_$E($P(PSJPDD,U,2),1,8),PSJ,48,26)
|
---|
| 18 | S:'PSJPDD VALMHDR(5)=$$SETSTR^VALM1("Last transferred: "_$$ENDTC^PSGMI(PSJPTD),PSJ,42,26)
|
---|
| 19 | Q
|
---|
| 20 | ;
|
---|
| 21 | HDRO(DFN) ; Standardized part of profile header.
|
---|
| 22 | N PSJCLIN,PSJAPPT,PSJCLINN,RMORDT S (PSJCLIN,PSJAPPT)=0,(RMORDAT,PSJCLINN)="" I $G(PSJORD) D
|
---|
| 23 | . S PSJCLIN=$S($G(PSJORD)["V":$G(^PS(55,DFN,"IV",+PSJORD,"DSS")),$G(PSJORD)["U":$G(^PS(55,DFN,5,+PSJORD,8)),$G(PSJORD)["P":$G(^PS(53.1,+PSJORD,"DSS")),1:"")
|
---|
| 24 | . S:PSJCLIN PSJAPPT=$P($G(PSJCLIN),U,2) I PSJCLIN,PSJAPPT S PSJCLINN=$P($G(^SC(+PSJCLIN,0)),U)
|
---|
| 25 | K VALMHDR I PSJCLINN]"" S PSJ=VADM(1),PSJ=$$SETSTR^VALM1(" Clinic: "_PSJCLINN,PSJ,28,26)
|
---|
| 26 | I PSJCLINN="" S PSJ=VADM(1),PSJ=$$SETSTR^VALM1($S('PSJPDD:" ",1:"Last ")_"Ward: "_PSJPWDN,PSJ,30,18)
|
---|
| 27 | S X=$$CWAD^ORQPT2(DFN)
|
---|
| 28 | S:X]"" X=IORVON_X_IORVOFF,PSJ=$$SETSTR^VALM1(X,PSJ,80-$L(X),80) S VALMHDR(1)=PSJ
|
---|
| 29 | S PSJ=" PID: "_$P(PSJPSSN,U,2)
|
---|
| 30 | S RMORDT=$S($G(PSJPDD):"Last ",1:" ")_"Room-Bed: "_$G(PSJPRB)
|
---|
| 31 | I PSJCLINN]"",PSJAPPT S RMORDT="Clinic Date: "_$$ENDTC^PSGMI(PSJAPPT),RMORDT=$P(RMORDT," ")_" "_$P(RMORDT," ",2)
|
---|
| 32 | S PSJ=$$SETSTR^VALM1(RMORDT,PSJ,26,28),VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_PSJPHT_" "_PSJPHTD,PSJ,55,25)
|
---|
| 33 | S PSJ=" DOB: "_$P($P(PSJPDOB,U,2)," ")_" ("_PSJPAGE_")",VALMHDR(3)=$$SETSTR^VALM1("Wt(kg): "_PSJPWT_" "_PSJPWTD,PSJ,55,25)
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | INIT(PSJPROT) ; -- init bld vars
|
---|
| 37 | ; PSJPROT=1:UD ONLY; 2:IV ONLY; 3:BOTH
|
---|
| 38 | K PSJUDPRF,^TMP("PSJ",$J),^TMP("PSJON",$J),^TMP("PSJPRO",$J)
|
---|
| 39 | S:PSJPROT=1 PSJUDPRF=1
|
---|
| 40 | D KILL^VALM10(),EN^PSJO1(PSJPROT)
|
---|
| 41 | I '$D(^TMP("PSJ",$J)) W !!,?22,"NO ORDERS FOUND FOR "_$S(PSJOL="S":"SHORT",1:"LONG")_" PROFILE." S VALMQUIT=1 D PAUSE^PSJLMUTL Q
|
---|
| 42 | S PSJTF=0,PSJLN=1,PSJEN=1,PSJC="" F S PSJC=$O(^TMP("PSJ",$J,PSJC)) Q:PSJC="" D
|
---|
| 43 | .S PSJF="^PS("_$S("AO"[PSJC:"55,"_PSGP_",5,",1:"53.1,")
|
---|
| 44 | .I PSJTF'=$E(PSJC,1)!(PSJC="CC")!(PSJC="CD")!(PSJC="BD") Q:PSJC="CB" Q:PSJC="O" D TF S PSJTF=$E(PSJC,1) ;DAM 8-29-07 Added Q:PSJC="CB" Q:PSJC="O"
|
---|
| 45 | .S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
|
---|
| 46 | .. S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" Q:PSJC="CB" Q:PSJC="O" D ON ;DAM 8-29-07 Added Q:PSJC="CB" Q:PSJC="O"
|
---|
| 47 | .;
|
---|
| 48 | .;DAM 8-29-07 New code to place Pending Orders after Pending Renewal Orders on the roll and scroll display. Non-Active Orders appear last.
|
---|
| 49 | S PSJTF=0,PSJC="" F S PSJC=$O(^TMP("PSJ",$J,PSJC)) Q:PSJC="" D
|
---|
| 50 | . S PSJF="^PS("_$S("AO"[PSJC:"55,"_PSGP_",5,",1:"53.1,")
|
---|
| 51 | . I PSJC="CB" D TF S PSJTF=$E(PSJC,1) ;These are Pending Orders
|
---|
| 52 | . I PSJC="CB" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
|
---|
| 53 | . . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" D ON
|
---|
| 54 | . I PSJC="O" D TF S PSJTF=$E(PSJC,1) ;These are Non-Active Orders
|
---|
| 55 | . I PSJC="O" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
|
---|
| 56 | . . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="" D ON
|
---|
| 57 | .; END DAM changes
|
---|
| 58 | .;
|
---|
| 59 | S VALMCNT=PSJLN-1
|
---|
| 60 | DONE ;
|
---|
| 61 | K PSJC,PSJEN,PSJLN,PSJST,PSJS,CNT,PSJPRI
|
---|
| 62 | Q
|
---|
| 63 | ;
|
---|
| 64 | ON ;
|
---|
| 65 | S PSJSCHT=$S(PSJOS:PSJS,1:PSJST)
|
---|
| 66 | S PSJO="" F FQ=0:0 S PSJO=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS,PSJO)) Q:PSJO="" S DN=^(PSJO) D
|
---|
| 67 | .N PRJPRI S PSJPRI=$S(PSJO["V":$P($G(^PS(55,PSGP,"IV",+PSJO,.2)),"^",4),PSJO["U":$P($G(^PS(55,PSGP,5,+PSJO,.2)),"^",4),1:$P($G(^PS(53.1,+PSJO,.2)),"^",4))
|
---|
| 68 | .S ^TMP("PSJON",$J,PSJEN)=PSJO,PSJL=$J(PSJEN,4) D @$S(PSJO["V":"PIV^PSJLMPRI(PSGP,PSJO,PSJF,DN)",PSJO["U":"PUD^PSJLMPRU(PSGP,PSJO,PSJF,DN)",1:"PIV^PSJLMPRI(PSGP,PSJO,PSJF,DN)") S ^TMP("PSJPRO",$J,0)=PSJEN,PSJEN=PSJEN+1
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|
| 71 | TF ; Set up order type header
|
---|
| 72 | I $D(^TMP("PSJ",$J,PSJC)) D
|
---|
| 73 | .N C,X,Y S C=PSJC,Y="",$P(Y," -",40)=""
|
---|
| 74 | .S X=$S(C="A":"A C T I V E",C["CC":"P E N D I N G R E N E W A L S",C["CD":"P E N D I N G C O M P L E X",C["C":"P E N D I N G ",C["BD":"N O N - V E R I F I E D C O M P L E X",C["B":"N O N - V E R I F I E D",1:"N O N - A C T I V E")
|
---|
| 75 | .S ^TMP("PSJPRO",$J,PSJLN,0)=$E($E(Y,1,(80-$L(X))/2)_" "_X_$E(Y,1,(80-$L(X))/2),1,80),PSJLN=PSJLN+1
|
---|
| 76 | Q
|
---|
| 77 | TEST ;
|
---|
| 78 | N X,Y S Y="",$P(Y," -",40)=""
|
---|
| 79 | F X="A C T I V E","P E N D I N G R E N E W A L S","P E N D I N G ","N O N - V E R I F I E D","N O N - A C T I V E" W !,$E($E(Y,1,(80-$L(X))/2)_" "_X_$E(Y,1,(80-$L(X))/2),1,80)
|
---|
| 80 | Q
|
---|