VistA-WorldVistAEHR/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBAPIPM.m

71 lines
3.4 KiB
Mathematica

PSBAPIPM ;BIRMINGHAM/EFC-BCMA API TO IPM FOR ORDER RENEWAL ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**6,15**;Mar 2004
;
;
EN(PSBDFN,PSBORDX) ;
;
; PSBLADT=date/time of the last action
; PSBADMDT=scheduled time of the last action
; PSBSTUS=last action (given, held, refused, etc.)
;
;
S (PSBCNT,PSBFLAG)=0,Y=""
S PSBSTR=""
I '$D(^PSB(53.79,"AORDX",PSBDFN,PSBORDX)) Q ""
F S Y=$O(^PSB(53.79,"AORDX",PSBDFN,PSBORDX,Y),-1) Q:Y="" Q:PSBFLAG=1 D
.S PSBLADT=$S(Y:Y,1:"")
.S X="" F S X=$O(^PSB(53.79,"AORDX",PSBDFN,PSBORDX,Y,X),-1) Q:X="" D
..S PSBSTUS=$P(^PSB(53.79,X,0),U,9) I PSBSTUS'="N" S PSBFLAG=1
..S PSBADMDT=$P(^PSB(53.79,X,.1),U,3)
..D:PSBSTUS="N"
...S (PSBLADT,PSBSTUS,PSBADMDT)=""
...S Z="" F S Z=$O(^PSB(53.79,X,.9,Z),-1) Q:'Z Q:PSBFLAG=1 S PSBDATA=$G(^(Z,0)) D
....I (PSBDATA["Set to 'NOT GIVEN'")!(PSBDATA["Set to 'GIVEN'")!(PSBDATA["Set to 'REFUSED'")!(PSBDATA["Set to 'HELD'")!(PSBDATA["Set to 'MISSING DOSE'")!(PSBDATA["Set to 'REMOVED'") S PSBCNT=PSBCNT+1
....I (PSBDATA["STATUS 'HELD'")!(PSBDATA["STATUS 'GIVEN'")!(PSBDATA["STATUS 'REFUSED'")!(PSBDATA["STATUS 'MISSING DOSE'")!(PSBDATA["STATUS 'REMOVED'") S PSBCNT=PSBCNT+1
....I PSBCNT#2=0,PSBDATA["'REFUSED'" S PSBSTUS="R",PSBADMDT=$P(^PSB(53.79,X,.1),U,3) D LAST
....I PSBCNT#2=0,PSBDATA["'HELD'" S PSBSTUS="H",PSBADMDT=$P(^PSB(53.79,X,.1),U,3) D LAST
....I PSBCNT#2=0,PSBDATA["'MISSING DOSE'" S PSBSTUS="M",PSBADMDT=$P(^PSB(53.79,X,.1),U,3) D LAST
....I PSBCNT#2=0,PSBDATA["'REMOVED'" S PSBSTUS="RM",PSBADMDT=$P(^PSB(53.79,X,.1),U,3) D LAST
I PSBSTUS'="" S PSBSTR=PSBADMDT_U_PSBLADT_U_PSBSTUS
Q PSBSTR
;
LAST ;
S PSBCC=0
S ZZ="" F S ZZ=$O(^PSB(53.79,X,.3,ZZ),-1) Q:'ZZ Q:PSBFLAG=1 S PSBDATA2=$G(^(ZZ,0)) D
.S PSBCC=PSBCC+1
.I PSBCC=2 S PSBLADT=$P(PSBDATA2,U,3),PSBFLAG=1
Q
MOB(PSBDFN,PSBCORN) ;
I '$D(^TMP("PSBMO",$J,PSBDFN,PSBCORN)) S ^TMP("PSB",$J,0)=-1 Q
M ^TMP("PSB",$J)=^TMP("PSBMO",$J,PSBDFN,PSBCORN)
K ^TMP("PSB",$J,"PSB")
Q
;
MOBR(PSBDFN,PSBCORN,PSBORDN) ;
I $G(PSBORDN)="" K ^TMP("PSB",$J) Q
S PSBDUZ=DUZ,PSBDUZ(2)=DUZ(2),DFN=PSBDFN
S DUZ=$P(^TMP("PSBMO",$J,PSBDFN,PSBCORN,"PSB"),U,1),DUZ(2)=$P(^TMP("PSBMO",$J,PSBDFN,PSBCORN,"PSB"),U,2),PSBISITE=$P(^TMP("PSBMO",$J,PSBDFN,PSBCORN,"PSB"),U,3)
D PSJ1^PSBVT(PSBDFN,PSBORDN)
S PSBREC(0)=PSBDFN
S PSBREC(1)=PSBONX
S PSBREC(2)=PSBSCHT
S PSBREC(4)=PSBOIT
S PSBREC(5)=$P(^TMP("PSBMO",$J,PSBDFN,PSBCORN,0),U,5)
S PSBREC(6)=""
S PSBREC(7)="BCMA/CPRS Interface Entry."
S PSBREC(8)=PSBISITE
I PSBONX["U" S PSBREC(9)="UDTAB^",PSBREC(3)="G"
I PSBONX["V" D
.I "PCS"'[PSBIVT S PSBREC(9)="IVTAB"_U_$$GETWSID^PSBVDLU2(PSBDFN,PSBORDN),PSBREC(3)="I" Q
.I PSBIVT["S",PSBISYR=0 S PSBREC(9)="IVTAB"_U_$$GETWSID^PSBVDLU2(PSBDFN,PSBORDN),PSBREC(3)="I" Q
.I PSBIVT["C",PSBISYR=0 S PSBREC(9)="IVTAB"_U_$$GETWSID^PSBVDLU2(PSBDFN,PSBORDN),PSBREC(3)="I" Q
.S PSBREC(9)="PBTAB"_U_$$GETWSID^PSBVDLU2(PSBDFN,PSBORDN),PSBREC(3)="G" Q
S PSBIMV="^"_$P($G(^TMP("PSBMO",$J,PSBDFN,PSBCORN,"PSB")),U,4)
S PSBINDX=10
S X="" F S X=$O(PSBDDA(X)) Q:X="" S PSBREC(PSBINDX)=$P(PSBDDA(X),U,1,2)_U_$P(PSBDDA(X),U,4)_U_$P(PSBDDA(X),U,4)_U_PSBDOSEF,PSBINDX=PSBINDX+1
S X="" F S X=$O(PSBADA(X)) Q:X="" S PSBREC(PSBINDX)=PSBADA(X),PSBINDX=PSBINDX+1
S X="" F S X=$O(PSBSOLA(X)) Q:X="" S PSBREC(PSBINDX)=PSBSOLA(X),PSBINDX=PSBINDX+1
D RPC^PSBML(.PSB,"+1^MEDPASS"_$G(PSBIMV),.PSBREC)
S DUZ=PSBDUZ,DUZ(2)=PSBDUZ(2) K PSBDUZ,PSBDUZ(2),^TMP("PSBMO",$J,PSBREC(0),PSBCORN),^TMP("PSB",$J) D CLEAN^PSBVT
Q