71 lines
3.4 KiB
Mathematica
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
|