- 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 Feb 18, 2025@23:07:23 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
