PSBPARIV ;BIRMINGHAM/EFC-BCMA IV PARAMETERS FUNCTIONS ;Mar 2004
;;3.0;BAR CODE MED ADMIN;;Mar 2004
;
; Reference/IA
; ^DIC(42/1377
; ^DIC(42/2440
; $$SITE^VASITE/10112
; $$GET^XPAR/2263
; WIN^DGPMDDCF/1246
;
WLIST(RESULTS,PSBEDIV) ; get the ward list for the IV Parameters GUI
K ^TMP("PSB",$J)
S RESULTS=$NAME(^TMP("PSB",$J)),^TMP("PSB",$J,0)=1,^TMP("PSB",$J,1)="ALL^1^0^1^1^1^1^1"
S PSBX="" F S PSBX=$O(^DIC(42,"B",PSBX)) Q:PSBX="" D
.S D0=$O(^DIC(42,"B",PSBX,"")) D WIN^DGPMDDCF Q:X=1
.S PSBD=$$GET1^DIQ(42,D0_",",.015,"I") Q:PSBD=""
.S PSBD=$P($$SITE^VASITE(DT,PSBD),U,1) Q:PSBD'=$G(PSBEDIV)
.S PSBNODE=^TMP("PSB",$J,0)+1,^TMP("PSB",$J,0)=PSBNODE,^TMP("PSB",$J,PSBNODE)=PSBX_"^0"
.I $D(^PSB(53.66,"B",D0)) S PSBIEN=$O(^PSB(53.66,"B",D0,"")),$P(^TMP("PSB",$J,PSBNODE),U,2)="1^"_PSBIEN_"^0^0^0^0^0" D
..S PSBY="" F S PSBY=$O(^PSB(53.66,PSBIEN,1,"B",PSBY)) Q:PSBY="" S $P(^TMP("PSB",$J,PSBNODE),U,$FIND("ACHPS",PSBY)+2)=1
Q
;
GETPAR(RESULTS,PSBWARD,PSBIVPT,PSBDIV) ;get parameters for a specific ward and type
K ^TMP("PSB",$J)
I $G(PSBDIV)'="" S PSBEDIV=PSBDIV
S RESULTS=$NAME(^TMP("PSB",$J)),^TMP("PSB",$J,0)="-1^Ward is not defined in BCMA IV PARAMETERS file 53.66"
D CHKDIV
S:PSBEDIV'["DIV.`" PSBEDIV="DIV.`"_PSBEDIV
I PSBWARD=0 D Q
.S PSBPAR=PSBIVPT_U_$$GET^XPAR(PSBEDIV,"PSBIV ADDITIVE",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV STRENGTH",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV BOTTLE",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV SOLUTION",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV VOLUME",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV INFUSION RATE",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV MED ROUTE",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV SCHEDULE",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV ADMIN TIME",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV REMARKS",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV OTHER PRINT INFO",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV START DATE/TIME",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV STOP DATE/TIME",PSBIVPT)
.S PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER COMMENTS",PSBIVPT)
.S ^TMP("PSB",$J,0)=PSBPAR
I '$D(^PSB(53.66,PSBWARD)) Q
I '$D(^PSB(53.66,PSBWARD,1,"B",PSBIVPT)) D Q
.S PSBIVPTX=$P("^ADDMIXTURE^PIGGYBACK^HYPERAL^SYRINGE^CHEMO",U,$F("APHSC",PSBIVPT))
.S ^TMP("PSB",$J,0)="-1^"_PSBIVPTX_" IV PARAMETERS NOT DEFINED FOR WARD"
S PSBPAR=$TR(^PSB(53.66,PSBWARD,1,$O(^PSB(53.66,PSBWARD,1,"B",PSBIVPT,0)),0),"WNI",123)
S ^TMP("PSB",$J,0)=PSBPAR
Q
;
CHKDIV ;
;
S:PSBEDIV'["DIV.`" PSBEDIV="DIV.`"_PSBEDIV
I '$$GET^XPAR(PSBEDIV,"PSBIV ADDITIVE") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV ADDITIVE",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV ADMIN TIME") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV ADMIN TIME",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV BOTTLE") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV BOTTLE",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV INFUSION RATE") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV INFUSION RATE",I,1)
I '$$GET^XPAR(PSBEDIV,"PSBIV MED ROUTE") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV MED ROUTE",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV OTHER PRINT INFO") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV OTHER PRINT INFO",I,1)
I '$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV PROVIDER",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER COMMENTS") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV PROVIDER COMMENTS",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV REMARKS") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV REMARKS",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV SCHEDULE") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV SCHEDULE",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV SOLUTION") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV SOLUTION",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV START DATE/TIME") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV START DATE/TIME",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV STOP DATE/TIME") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV STOP DATE/TIME",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV STRENGTH") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV STRENGTH",I,3)
I '$$GET^XPAR(PSBEDIV,"PSBIV VOLUME") F I=1:1:5 D EN^XPAR(PSBEDIV,"PSBIV VOLUME",I,3)
Q
;
PUTPAR(RESULTS,PSBWARD,PSBPARS,PSBDIV) ; set 53.66 (parameters file) with input iv parameters
K ^TMP("PSB",$J)
I $G(PSBDIV)'="" S PSBEDIV=PSBDIV
N PSBDIEN S PSBDIEN=+($G(PSBEDIV))
S:PSBEDIV'["DIV.`" PSBEDIV="DIV.`"_PSBEDIV
N PSBFDA,PSBMSG,PSBWD,PSBIVPT,X,Z,PSBIVPR,I,K
S RESULTS=$NAME(^TMP("PSB",$J))
S PSBWARD=$G(PSBWARD)
S PSBPARS=$G(PSBPARS)
I $G(PSBDIEN)="" S ^TMP("PSB",$J,0)="-1^Division IEN required for ward"_$G(PSBWARD) Q
S PSBWD=$P(PSBWARD,U,1),PSBIEN=$P(PSBWARD,U,2)
S X="^ADDITIVE^STRENGTH^BOTTLE^SOLUTION^VOLUME^INFUSION RATE^MED ROUTE^SCHEDULE^ADMIN TIME"
S X=X_"^REMARKS^OTHER PRINT INFO^PROVIDER^START DATE/TIME^STOP DATE/TIME^PROVIDER COMMENTS"
S PSBIVPT=$P(PSBPARS,U,1)
I PSBWD="ALL" D Q
.S K=2,PSBIVPT=$S(PSBIVPT="A":1,PSBIVPT="P":2,PSBIVPT="H":3,PSBIVPT="S":4,1:5)
.F I=2:1 Q:$P(X,U,I)="" S PSBIVPR(I)="PSBIV"_" "_$P(X,U,I)
.F I=2:1:16 D EN^XPAR(PSBEDIV,$G(PSBIVPR(I)),PSBIVPT,$P(PSBPARS,U,K)) S K=K+1
.S ^TMP("PSB",$J,0)="1^Parameters Saved"
F I=2:1 Q:$P(PSBPARS,U,I)="" S $P(PSBPARS,U,I)=$TR($P(PSBPARS,U,I),123,"WNI")
I PSBWD'="ALL" D
.S PSBWIEN=$O(^DIC(42,"B",PSBWD,""))
.S PSBDIVPT=$$GET1^DIQ(42,PSBWIEN_",",.015,"I")
.I $P($$SITE^VASITE(DT,PSBDIVPT),U,1)'=PSBDIEN S ^TMP("PSB",$J,0)="-1^Data NOT filed - invalid Division IEN" Q
.I $P(PSBPARS,U,2)'="" D
..I $D(^PSB(53.66,"B",PSBWIEN)),$D(^PSB(53.66,PSBIEN,1,"B",PSBIVPT)) D MODIFY ;Modify an existing ward,ivtype
..I $D(^PSB(53.66,"B",PSBWIEN)),'$D(^PSB(53.66,PSBIEN,1,"B",PSBIVPT)) D ADD ;ward exists but not type
..I '$D(^PSB(53.66,"B",PSBWIEN)) D NEW ;Create a new ward
.I $P(PSBPARS,U,2)="" D RESET ;Delete an existing ward
Q
NEW ;
S PSBIEN="+1,"
S PSBFDA(53.66,PSBIEN,.01)=$G(PSBWIEN)
D FILEIT
S PSBIEN="+1,"_PSBIEN(1)_","
S PSBFDA(53.67,PSBIEN,.01)=PSBIVPT
S PSBFDA(53.67,PSBIEN,1)=$P(PSBPARS,U,2)
F I=5:5:70 S PSBFDA(53.67,PSBIEN,I)=""
S K=3,I=1 F S I=$O(PSBFDA(53.67,PSBIEN,I)) Q:I="" S PSBFDA(53.67,PSBIEN,I)=$P(PSBPARS,U,K),K=K+1
S PSBIEN(1)=""
D FILEIT
Q:$D(PSBMSG("DIERR"))
S ^TMP("PSB",$J,0)="1^Data successfully filed^"_$G(PSBIEN(1))
Q
MODIFY ;
S PSBIEN=$O(^PSB(53.66,"B",PSBWIEN,""))
S Z=$O(^PSB(53.66,PSBIEN,1,"B",PSBIVPT,""))
S PSBIEN=Z_","_PSBIEN_","
S PSBFDA(53.67,PSBIEN,.01)=PSBIVPT
S PSBFDA(53.67,PSBIEN,1)=$P(PSBPARS,U,2)
F I=5:5:70 S PSBFDA(53.67,PSBIEN,I)=""
S K=3,I=1 F S I=$O(PSBFDA(53.67,PSBIEN,I)) Q:I="" S PSBFDA(53.67,PSBIEN,I)=$P(PSBPARS,U,K),K=K+1
D FILEIT
Q:$D(PSBMSG("DIERR"))
S ^TMP("PSB",$J,0)="1^Data successfully filed^"
Q
ADD ;
S PSBIEN=$O(^PSB(53.66,"B",PSBWIEN,""))
S PSBIEN="+1"_","_PSBIEN_","
S PSBFDA(53.67,PSBIEN,.01)=PSBIVPT
S PSBFDA(53.67,PSBIEN,1)=$P(PSBPARS,U,2)
F I=5:5:70 S PSBFDA(53.67,PSBIEN,I)=""
S K=3,I=1 F S I=$O(PSBFDA(53.67,PSBIEN,I)) Q:I="" S PSBFDA(53.67,PSBIEN,I)=$P(PSBPARS,U,K),K=K+1
D FILEIT
Q:$D(PSBMSG("DIERR"))
S ^TMP("PSB",$J,0)="1^Data successfully filed^"
Q
RESET ;
N DIK,DA
S DIK="^PSB(53.66,"
S DA=PSBIEN
D ^DIK
S ^TMP("PSB",$J,0)="1^Data successfully deleted^"
Q
FILEIT ;
D CLEAN^DILF
D UPDATE^DIE("","PSBFDA","PSBIEN","PSBMSG")
I $D(PSBMSG("DIERR")) S ^TMP("PSB",$J,0)="-1^"_PSBMSG("DIERR",1)_": "_PSBMSG("DIERR",1,"TEXT",1) Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBPARIV 7489 printed Dec 13, 2024@01:41 Page 2
PSBPARIV ;BIRMINGHAM/EFC-BCMA IV PARAMETERS FUNCTIONS ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
+2 ;
+3 ; Reference/IA
+4 ; ^DIC(42/1377
+5 ; ^DIC(42/2440
+6 ; $$SITE^VASITE/10112
+7 ; $$GET^XPAR/2263
+8 ; WIN^DGPMDDCF/1246
+9 ;
WLIST(RESULTS,PSBEDIV) ; get the ward list for the IV Parameters GUI
+1 KILL ^TMP("PSB",$JOB)
+2 SET RESULTS=$NAME(^TMP("PSB",$JOB))
SET ^TMP("PSB",$JOB,0)=1
SET ^TMP("PSB",$JOB,1)="ALL^1^0^1^1^1^1^1"
+3 SET PSBX=""
FOR
SET PSBX=$ORDER(^DIC(42,"B",PSBX))
if PSBX=""
QUIT
Begin DoDot:1
+4 SET D0=$ORDER(^DIC(42,"B",PSBX,""))
DO WIN^DGPMDDCF
if X=1
QUIT
+5 SET PSBD=$$GET1^DIQ(42,D0_",",.015,"I")
if PSBD=""
QUIT
+6 SET PSBD=$PIECE($$SITE^VASITE(DT,PSBD),U,1)
if PSBD'=$GET(PSBEDIV)
QUIT
+7 SET PSBNODE=^TMP("PSB",$JOB,0)+1
SET ^TMP("PSB",$JOB,0)=PSBNODE
SET ^TMP("PSB",$JOB,PSBNODE)=PSBX_"^0"
+8 IF $DATA(^PSB(53.66,"B",D0))
SET PSBIEN=$ORDER(^PSB(53.66,"B",D0,""))
SET $PIECE(^TMP("PSB",$JOB,PSBNODE),U,2)="1^"_PSBIEN_"^0^0^0^0^0"
Begin DoDot:2
+9 SET PSBY=""
FOR
SET PSBY=$ORDER(^PSB(53.66,PSBIEN,1,"B",PSBY))
if PSBY=""
QUIT
SET $PIECE(^TMP("PSB",$JOB,PSBNODE),U,$FIND("ACHPS",PSBY)+2)=1
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
GETPAR(RESULTS,PSBWARD,PSBIVPT,PSBDIV) ;get parameters for a specific ward and type
+1 KILL ^TMP("PSB",$JOB)
+2 IF $GET(PSBDIV)'=""
SET PSBEDIV=PSBDIV
+3 SET RESULTS=$NAME(^TMP("PSB",$JOB))
SET ^TMP("PSB",$JOB,0)="-1^Ward is not defined in BCMA IV PARAMETERS file 53.66"
+4 DO CHKDIV
+5 if PSBEDIV'["DIV.`"
SET PSBEDIV="DIV.`"_PSBEDIV
+6 IF PSBWARD=0
Begin DoDot:1
+7 SET PSBPAR=PSBIVPT_U_$$GET^XPAR(PSBEDIV,"PSBIV ADDITIVE",PSBIVPT)
+8 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV STRENGTH",PSBIVPT)
+9 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV BOTTLE",PSBIVPT)
+10 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV SOLUTION",PSBIVPT)
+11 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV VOLUME",PSBIVPT)
+12 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV INFUSION RATE",PSBIVPT)
+13 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV MED ROUTE",PSBIVPT)
+14 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV SCHEDULE",PSBIVPT)
+15 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV ADMIN TIME",PSBIVPT)
+16 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV REMARKS",PSBIVPT)
+17 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV OTHER PRINT INFO",PSBIVPT)
+18 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER",PSBIVPT)
+19 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV START DATE/TIME",PSBIVPT)
+20 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV STOP DATE/TIME",PSBIVPT)
+21 SET PSBPAR=PSBPAR_U_$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER COMMENTS",PSBIVPT)
+22 SET ^TMP("PSB",$JOB,0)=PSBPAR
End DoDot:1
QUIT
+23 IF '$DATA(^PSB(53.66,PSBWARD))
QUIT
+24 IF '$DATA(^PSB(53.66,PSBWARD,1,"B",PSBIVPT))
Begin DoDot:1
+25 SET PSBIVPTX=$PIECE("^ADDMIXTURE^PIGGYBACK^HYPERAL^SYRINGE^CHEMO",U,$FIND("APHSC",PSBIVPT))
+26 SET ^TMP("PSB",$JOB,0)="-1^"_PSBIVPTX_" IV PARAMETERS NOT DEFINED FOR WARD"
End DoDot:1
QUIT
+27 SET PSBPAR=$TRANSLATE(^PSB(53.66,PSBWARD,1,$ORDER(^PSB(53.66,PSBWARD,1,"B",PSBIVPT,0)),0),"WNI",123)
+28 SET ^TMP("PSB",$JOB,0)=PSBPAR
+29 QUIT
+30 ;
CHKDIV ;
+1 ;
+2 if PSBEDIV'["DIV.`"
SET PSBEDIV="DIV.`"_PSBEDIV
+3 IF '$$GET^XPAR(PSBEDIV,"PSBIV ADDITIVE")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV ADDITIVE",I,3)
+4 IF '$$GET^XPAR(PSBEDIV,"PSBIV ADMIN TIME")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV ADMIN TIME",I,3)
+5 IF '$$GET^XPAR(PSBEDIV,"PSBIV BOTTLE")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV BOTTLE",I,3)
+6 IF '$$GET^XPAR(PSBEDIV,"PSBIV INFUSION RATE")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV INFUSION RATE",I,1)
+7 IF '$$GET^XPAR(PSBEDIV,"PSBIV MED ROUTE")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV MED ROUTE",I,3)
+8 IF '$$GET^XPAR(PSBEDIV,"PSBIV OTHER PRINT INFO")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV OTHER PRINT INFO",I,1)
+9 IF '$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV PROVIDER",I,3)
+10 IF '$$GET^XPAR(PSBEDIV,"PSBIV PROVIDER COMMENTS")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV PROVIDER COMMENTS",I,3)
+11 IF '$$GET^XPAR(PSBEDIV,"PSBIV REMARKS")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV REMARKS",I,3)
+12 IF '$$GET^XPAR(PSBEDIV,"PSBIV SCHEDULE")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV SCHEDULE",I,3)
+13 IF '$$GET^XPAR(PSBEDIV,"PSBIV SOLUTION")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV SOLUTION",I,3)
+14 IF '$$GET^XPAR(PSBEDIV,"PSBIV START DATE/TIME")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV START DATE/TIME",I,3)
+15 IF '$$GET^XPAR(PSBEDIV,"PSBIV STOP DATE/TIME")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV STOP DATE/TIME",I,3)
+16 IF '$$GET^XPAR(PSBEDIV,"PSBIV STRENGTH")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV STRENGTH",I,3)
+17 IF '$$GET^XPAR(PSBEDIV,"PSBIV VOLUME")
FOR I=1:1:5
DO EN^XPAR(PSBEDIV,"PSBIV VOLUME",I,3)
+18 QUIT
+19 ;
PUTPAR(RESULTS,PSBWARD,PSBPARS,PSBDIV) ; set 53.66 (parameters file) with input iv parameters
+1 KILL ^TMP("PSB",$JOB)
+2 IF $GET(PSBDIV)'=""
SET PSBEDIV=PSBDIV
+3 NEW PSBDIEN
SET PSBDIEN=+($GET(PSBEDIV))
+4 if PSBEDIV'["DIV.`"
SET PSBEDIV="DIV.`"_PSBEDIV
+5 NEW PSBFDA,PSBMSG,PSBWD,PSBIVPT,X,Z,PSBIVPR,I,K
+6 SET RESULTS=$NAME(^TMP("PSB",$JOB))
+7 SET PSBWARD=$GET(PSBWARD)
+8 SET PSBPARS=$GET(PSBPARS)
+9 IF $GET(PSBDIEN)=""
SET ^TMP("PSB",$JOB,0)="-1^Division IEN required for ward"_$GET(PSBWARD)
QUIT
+10 SET PSBWD=$PIECE(PSBWARD,U,1)
SET PSBIEN=$PIECE(PSBWARD,U,2)
+11 SET X="^ADDITIVE^STRENGTH^BOTTLE^SOLUTION^VOLUME^INFUSION RATE^MED ROUTE^SCHEDULE^ADMIN TIME"
+12 SET X=X_"^REMARKS^OTHER PRINT INFO^PROVIDER^START DATE/TIME^STOP DATE/TIME^PROVIDER COMMENTS"
+13 SET PSBIVPT=$PIECE(PSBPARS,U,1)
+14 IF PSBWD="ALL"
Begin DoDot:1
+15 SET K=2
SET PSBIVPT=$SELECT(PSBIVPT="A":1,PSBIVPT="P":2,PSBIVPT="H":3,PSBIVPT="S":4,1:5)
+16 FOR I=2:1
if $PIECE(X,U,I)=""
QUIT
SET PSBIVPR(I)="PSBIV"_" "_$PIECE(X,U,I)
+17 FOR I=2:1:16
DO EN^XPAR(PSBEDIV,$GET(PSBIVPR(I)),PSBIVPT,$PIECE(PSBPARS,U,K))
SET K=K+1
+18 SET ^TMP("PSB",$JOB,0)="1^Parameters Saved"
End DoDot:1
QUIT
+19 FOR I=2:1
if $PIECE(PSBPARS,U,I)=""
QUIT
SET $PIECE(PSBPARS,U,I)=$TRANSLATE($PIECE(PSBPARS,U,I),123,"WNI")
+20 IF PSBWD'="ALL"
Begin DoDot:1
+21 SET PSBWIEN=$ORDER(^DIC(42,"B",PSBWD,""))
+22 SET PSBDIVPT=$$GET1^DIQ(42,PSBWIEN_",",.015,"I")
+23 IF $PIECE($$SITE^VASITE(DT,PSBDIVPT),U,1)'=PSBDIEN
SET ^TMP("PSB",$JOB,0)="-1^Data NOT filed - invalid Division IEN"
QUIT
+24 IF $PIECE(PSBPARS,U,2)'=""
Begin DoDot:2
+25 ;Modify an existing ward,ivtype
IF $DATA(^PSB(53.66,"B",PSBWIEN))
IF $DATA(^PSB(53.66,PSBIEN,1,"B",PSBIVPT))
DO MODIFY
+26 ;ward exists but not type
IF $DATA(^PSB(53.66,"B",PSBWIEN))
IF '$DATA(^PSB(53.66,PSBIEN,1,"B",PSBIVPT))
DO ADD
+27 ;Create a new ward
IF '$DATA(^PSB(53.66,"B",PSBWIEN))
DO NEW
End DoDot:2
+28 ;Delete an existing ward
IF $PIECE(PSBPARS,U,2)=""
DO RESET
End DoDot:1
+29 QUIT
NEW ;
+1 SET PSBIEN="+1,"
+2 SET PSBFDA(53.66,PSBIEN,.01)=$GET(PSBWIEN)
+3 DO FILEIT
+4 SET PSBIEN="+1,"_PSBIEN(1)_","
+5 SET PSBFDA(53.67,PSBIEN,.01)=PSBIVPT
+6 SET PSBFDA(53.67,PSBIEN,1)=$PIECE(PSBPARS,U,2)
+7 FOR I=5:5:70
SET PSBFDA(53.67,PSBIEN,I)=""
+8 SET K=3
SET I=1
FOR
SET I=$ORDER(PSBFDA(53.67,PSBIEN,I))
if I=""
QUIT
SET PSBFDA(53.67,PSBIEN,I)=$PIECE(PSBPARS,U,K)
SET K=K+1
+9 SET PSBIEN(1)=""
+10 DO FILEIT
+11 if $DATA(PSBMSG("DIERR"))
QUIT
+12 SET ^TMP("PSB",$JOB,0)="1^Data successfully filed^"_$GET(PSBIEN(1))
+13 QUIT
MODIFY ;
+1 SET PSBIEN=$ORDER(^PSB(53.66,"B",PSBWIEN,""))
+2 SET Z=$ORDER(^PSB(53.66,PSBIEN,1,"B",PSBIVPT,""))
+3 SET PSBIEN=Z_","_PSBIEN_","
+4 SET PSBFDA(53.67,PSBIEN,.01)=PSBIVPT
+5 SET PSBFDA(53.67,PSBIEN,1)=$PIECE(PSBPARS,U,2)
+6 FOR I=5:5:70
SET PSBFDA(53.67,PSBIEN,I)=""
+7 SET K=3
SET I=1
FOR
SET I=$ORDER(PSBFDA(53.67,PSBIEN,I))
if I=""
QUIT
SET PSBFDA(53.67,PSBIEN,I)=$PIECE(PSBPARS,U,K)
SET K=K+1
+8 DO FILEIT
+9 if $DATA(PSBMSG("DIERR"))
QUIT
+10 SET ^TMP("PSB",$JOB,0)="1^Data successfully filed^"
+11 QUIT
ADD ;
+1 SET PSBIEN=$ORDER(^PSB(53.66,"B",PSBWIEN,""))
+2 SET PSBIEN="+1"_","_PSBIEN_","
+3 SET PSBFDA(53.67,PSBIEN,.01)=PSBIVPT
+4 SET PSBFDA(53.67,PSBIEN,1)=$PIECE(PSBPARS,U,2)
+5 FOR I=5:5:70
SET PSBFDA(53.67,PSBIEN,I)=""
+6 SET K=3
SET I=1
FOR
SET I=$ORDER(PSBFDA(53.67,PSBIEN,I))
if I=""
QUIT
SET PSBFDA(53.67,PSBIEN,I)=$PIECE(PSBPARS,U,K)
SET K=K+1
+7 DO FILEIT
+8 if $DATA(PSBMSG("DIERR"))
QUIT
+9 SET ^TMP("PSB",$JOB,0)="1^Data successfully filed^"
+10 QUIT
RESET ;
+1 NEW DIK,DA
+2 SET DIK="^PSB(53.66,"
+3 SET DA=PSBIEN
+4 DO ^DIK
+5 SET ^TMP("PSB",$JOB,0)="1^Data successfully deleted^"
+6 QUIT
FILEIT ;
+1 DO CLEAN^DILF
+2 DO UPDATE^DIE("","PSBFDA","PSBIEN","PSBMSG")
+3 IF $DATA(PSBMSG("DIERR"))
SET ^TMP("PSB",$JOB,0)="-1^"_PSBMSG("DIERR",1)_": "_PSBMSG("DIERR",1,"TEXT",1)
QUIT
+4 QUIT
