ORSPUTIL ;SLC/JMH - SUPPLY CONVERSION UTILITY ;08/29/17 08:48
;;3.0;ORDER ENTRY/RESULTS REPORTING;**423,397**;Dec 17, 1997;Build 22
;
;
;
SUPPLYNF ;if OI is marked as NON-FORMULARY and SUPPLY then set QO-ONLY to yes for SUPPLY
W @IOF
W "This utility will convert all items from the ORDERABLE ITEMS file that are "
W !,"marked for both Supplies and Non-Formulary, to be QO-ONLY to YES for"
W !,"Supplies."
I '$$SURE("Are you sure you want to continue?") Q
N I
S I=0 F S I=$O(^ORD(101.43,I)) Q:'I D
.Q:'$D(^ORD(101.43,I,"PS"))
.Q:'$P(^ORD(101.43,I,"PS"),U,5) ;quit if not set to supply
.Q:'$P(^ORD(101.43,I,"PS"),U,6) ;quit if not set to non-formulary
.W !,"OI IEN: ",I,?20,"OI NAME: ",$P(^ORD(101.43,I,0),U)
.D SET("SPLY",I)
Q
;
COPYO2S ;if OI is marked QO-ONLY for OUTPATIENT Med then set QO-ONLY to yes for SUPPLY
W @IOF
W "This utility will convert all items from the ORDERABLE ITEMS file that are "
W !,"marked for Supplies and also set as QO-ONLY yes for Outpatient Meds,"
W !,"to be QO-ONLY to YES for Supplies."
I '$$SURE("Are you sure you want to continue?") Q
N I
S I=0 F S I=$O(^ORD(101.43,I)) Q:'I D
.Q:'$D(^ORD(101.43,I,"PS"))
.Q:'$P(^ORD(101.43,I,"PS"),U,5) ;quit if not set to supply
.Q:'$$GET("O RX",I) ;quit if not set to YES for QO-ONLY for outpatient meds
.W !,"OI IEN: ",I,?20,"OI NAME: ",$P(^ORD(101.43,I,0),U)
.D SET("SPLY",I)
Q
;
SUPPLYQO ; Convert Outpatient Med QO to Supply dialog
;
N ORCOUNT,ORDGPSO,ORDGSUP,ORDLGOI,ORERR,ORERRFLAG,ORFDA,ORIEN,OROIIEN,ORX
;
W @IOF
W "This utility will convert all Outpatient Medication quick orders that were"
W !,"built for orderable items that are considered supply items, to use the"
W !,"PSO SUPPLY dialog."
I '$$SURE("Are you sure you want to continue?") Q
W !!
;
S ORDGPSO=+$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
I 'ORDGPSO D ERROR("Unable to find the OUTPATIENT MEDICATIONS display group.") Q
S ORDGSUP=+$O(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
I 'ORDGSUP D ERROR("Unable to find the SUPPLIES/DEVICES display group.") Q
S ORDLGOI=+$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
I 'ORDLGOI D ERROR("Unable to find the OR GTX ORDERABLE ITEM dialog.") Q
;
S ORCOUNT=0
S ORIEN=0
F S ORIEN=$O(^ORD(101.41,ORIEN)) Q:'ORIEN D
. ; Skip disabled quick order (field #3 not blank)
. I $P(^ORD(101.41,ORIEN,0),U,3)'="" Q
. ; Skip non-quick order
. I $P(^ORD(101.41,ORIEN,0),U,4)'="Q" Q
. ; Skip non-outpatient medications
. I $P(^ORD(101.41,ORIEN,0),U,5)'=ORDGPSO Q
. ;
. ; Determine if the orderable item is a supply
. S ORX=+$O(^ORD(101.41,ORIEN,6,"D",ORDLGOI,0))
. I 'ORX Q
. S OROIIEN=+$P($G(^ORD(101.41,ORIEN,6,ORX,1)),U,1)
. I 'OROIIEN Q
. I $P($P($G(^ORD(101.43,OROIIEN,0)),U,2),";",2)'="99PSP" Q
. I $$ISOISPLY^ORUTL3(OROIIEN) D
. . K ORERR,ORFDA
. . S ORFDA(101.41,ORIEN_",",5)=ORDGSUP
. . D FILE^DIE("K","ORFDA","ORERR")
. . I $D(ORERR) D
. . . D ERRORFM("Unable to convert quick order '"_$P($G(^ORD(101.41,ORIEN,0)),U,1)_"' (IEN #"_ORIEN_")",.ORERR)
. . . S ORERRFLAG=1
. . E D
. . . W !,"QO IEN: ",ORIEN,?20,"QO NAME: ",$P($G(^ORD(101.41,ORIEN,0)),U,1)
. . . S ORCOUNT=ORCOUNT+1
;
I $G(ORERRFLAG) D
. W !!,"There were some quick orders that could not be converted."
. W !,"Please see output above for more information."
. W !!,"Please log a CA SDM ticket for assistance.",!
E D
. W !!,"The quick order conversion completed successfully."
;
I ORCOUNT>0 D
. W !,ORCOUNT_" quick order"_$S(ORCOUNT=1:" was",1:"s were")_" converted.",!!
E D
. W !,"No quick orders were converted"_$S('$G(ORERRFLAG):", as none met the search criteria.",1:"."),!!
H 1
;
Q
;
GET(CODE,ORIEN) ;get the current status of QO-ONLY for a specific package type(CODE)
N DA,ORY S ORY=0
S DA=$O(^ORD(101.43,ORIEN,9,"B",CODE,""))
I DA D
.I $P($G(^ORD(101.43,ORIEN,9,DA,0)),U,2) S ORY=1
Q ORY
;
SET(CODE,ORIEN) ;set the status of QO-ONLY to YES for a specific package type(CODE)
N ORDA
S ORDA=$O(^ORD(101.43,ORIEN,9,"B",CODE,""))
I ORDA D
.N DA,DR,DIE
.S DA(1)=ORIEN,DA=ORDA,DR=2_"///YES",DIE="^ORD(101.43,"_DA(1)_",9," D ^DIE
Q
;
SURE(ORMSG) ; -- sure you want to delete?
N X,Y,DIR
S DIR(0)="YA",DIR("A")=" "_ORMSG_" "
S DIR("B")="NO" W $C(7) D ^DIR
S:$D(DTOUT) Y="^"
Q Y
;
ERROR(ORERROR) ;
W !!,ORERROR
W !,"Please log a CA SDM ticket for assistance.",!
H 2
Q
;
ERRORFM(ORTEXT,ORERROR) ; Output FileMan Error Messages
N ORX
W !!,"ERROR: "_ORTEXT_"."
W !,"VA FileMan Error #"_$G(ORERROR("DIERR",1))_":"
F ORX=1:1:+$O(ORERROR("DIERR",1,"TEXT","A"),-1) D
. W !,$G(ORERROR("DIERR",1,"TEXT",ORX))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORSPUTIL 4701 printed Dec 13, 2024@02:34:16 Page 2
ORSPUTIL ;SLC/JMH - SUPPLY CONVERSION UTILITY ;08/29/17 08:48
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**423,397**;Dec 17, 1997;Build 22
+2 ;
+3 ;
+4 ;
SUPPLYNF ;if OI is marked as NON-FORMULARY and SUPPLY then set QO-ONLY to yes for SUPPLY
+1 WRITE @IOF
+2 WRITE "This utility will convert all items from the ORDERABLE ITEMS file that are "
+3 WRITE !,"marked for both Supplies and Non-Formulary, to be QO-ONLY to YES for"
+4 WRITE !,"Supplies."
+5 IF '$$SURE("Are you sure you want to continue?")
QUIT
+6 NEW I
+7 SET I=0
FOR
SET I=$ORDER(^ORD(101.43,I))
if 'I
QUIT
Begin DoDot:1
+8 if '$DATA(^ORD(101.43,I,"PS"))
QUIT
+9 ;quit if not set to supply
if '$PIECE(^ORD(101.43,I,"PS"),U,5)
QUIT
+10 ;quit if not set to non-formulary
if '$PIECE(^ORD(101.43,I,"PS"),U,6)
QUIT
+11 WRITE !,"OI IEN: ",I,?20,"OI NAME: ",$PIECE(^ORD(101.43,I,0),U)
+12 DO SET("SPLY",I)
End DoDot:1
+13 QUIT
+14 ;
COPYO2S ;if OI is marked QO-ONLY for OUTPATIENT Med then set QO-ONLY to yes for SUPPLY
+1 WRITE @IOF
+2 WRITE "This utility will convert all items from the ORDERABLE ITEMS file that are "
+3 WRITE !,"marked for Supplies and also set as QO-ONLY yes for Outpatient Meds,"
+4 WRITE !,"to be QO-ONLY to YES for Supplies."
+5 IF '$$SURE("Are you sure you want to continue?")
QUIT
+6 NEW I
+7 SET I=0
FOR
SET I=$ORDER(^ORD(101.43,I))
if 'I
QUIT
Begin DoDot:1
+8 if '$DATA(^ORD(101.43,I,"PS"))
QUIT
+9 ;quit if not set to supply
if '$PIECE(^ORD(101.43,I,"PS"),U,5)
QUIT
+10 ;quit if not set to YES for QO-ONLY for outpatient meds
if '$$GET("O RX",I)
QUIT
+11 WRITE !,"OI IEN: ",I,?20,"OI NAME: ",$PIECE(^ORD(101.43,I,0),U)
+12 DO SET("SPLY",I)
End DoDot:1
+13 QUIT
+14 ;
SUPPLYQO ; Convert Outpatient Med QO to Supply dialog
+1 ;
+2 NEW ORCOUNT,ORDGPSO,ORDGSUP,ORDLGOI,ORERR,ORERRFLAG,ORFDA,ORIEN,OROIIEN,ORX
+3 ;
+4 WRITE @IOF
+5 WRITE "This utility will convert all Outpatient Medication quick orders that were"
+6 WRITE !,"built for orderable items that are considered supply items, to use the"
+7 WRITE !,"PSO SUPPLY dialog."
+8 IF '$$SURE("Are you sure you want to continue?")
QUIT
+9 WRITE !!
+10 ;
+11 SET ORDGPSO=+$ORDER(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
+12 IF 'ORDGPSO
DO ERROR("Unable to find the OUTPATIENT MEDICATIONS display group.")
QUIT
+13 SET ORDGSUP=+$ORDER(^ORD(100.98,"B","SUPPLIES/DEVICES",0))
+14 IF 'ORDGSUP
DO ERROR("Unable to find the SUPPLIES/DEVICES display group.")
QUIT
+15 SET ORDLGOI=+$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
+16 IF 'ORDLGOI
DO ERROR("Unable to find the OR GTX ORDERABLE ITEM dialog.")
QUIT
+17 ;
+18 SET ORCOUNT=0
+19 SET ORIEN=0
+20 FOR
SET ORIEN=$ORDER(^ORD(101.41,ORIEN))
if 'ORIEN
QUIT
Begin DoDot:1
+21 ; Skip disabled quick order (field #3 not blank)
+22 IF $PIECE(^ORD(101.41,ORIEN,0),U,3)'=""
QUIT
+23 ; Skip non-quick order
+24 IF $PIECE(^ORD(101.41,ORIEN,0),U,4)'="Q"
QUIT
+25 ; Skip non-outpatient medications
+26 IF $PIECE(^ORD(101.41,ORIEN,0),U,5)'=ORDGPSO
QUIT
+27 ;
+28 ; Determine if the orderable item is a supply
+29 SET ORX=+$ORDER(^ORD(101.41,ORIEN,6,"D",ORDLGOI,0))
+30 IF 'ORX
QUIT
+31 SET OROIIEN=+$PIECE($GET(^ORD(101.41,ORIEN,6,ORX,1)),U,1)
+32 IF 'OROIIEN
QUIT
+33 IF $PIECE($PIECE($GET(^ORD(101.43,OROIIEN,0)),U,2),";",2)'="99PSP"
QUIT
+34 IF $$ISOISPLY^ORUTL3(OROIIEN)
Begin DoDot:2
+35 KILL ORERR,ORFDA
+36 SET ORFDA(101.41,ORIEN_",",5)=ORDGSUP
+37 DO FILE^DIE("K","ORFDA","ORERR")
+38 IF $DATA(ORERR)
Begin DoDot:3
+39 DO ERRORFM("Unable to convert quick order '"_$PIECE($GET(^ORD(101.41,ORIEN,0)),U,1)_"' (IEN #"_ORIEN_")",.ORERR)
+40 SET ORERRFLAG=1
End DoDot:3
+41 IF '$TEST
Begin DoDot:3
+42 WRITE !,"QO IEN: ",ORIEN,?20,"QO NAME: ",$PIECE($GET(^ORD(101.41,ORIEN,0)),U,1)
+43 SET ORCOUNT=ORCOUNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+44 ;
+45 IF $GET(ORERRFLAG)
Begin DoDot:1
+46 WRITE !!,"There were some quick orders that could not be converted."
+47 WRITE !,"Please see output above for more information."
+48 WRITE !!,"Please log a CA SDM ticket for assistance.",!
End DoDot:1
+49 IF '$TEST
Begin DoDot:1
+50 WRITE !!,"The quick order conversion completed successfully."
End DoDot:1
+51 ;
+52 IF ORCOUNT>0
Begin DoDot:1
+53 WRITE !,ORCOUNT_" quick order"_$SELECT(ORCOUNT=1:" was",1:"s were")_" converted.",!!
End DoDot:1
+54 IF '$TEST
Begin DoDot:1
+55 WRITE !,"No quick orders were converted"_$SELECT('$GET(ORERRFLAG):", as none met the search criteria.",1:"."),!!
End DoDot:1
+56 HANG 1
+57 ;
+58 QUIT
+59 ;
GET(CODE,ORIEN) ;get the current status of QO-ONLY for a specific package type(CODE)
+1 NEW DA,ORY
SET ORY=0
+2 SET DA=$ORDER(^ORD(101.43,ORIEN,9,"B",CODE,""))
+3 IF DA
Begin DoDot:1
+4 IF $PIECE($GET(^ORD(101.43,ORIEN,9,DA,0)),U,2)
SET ORY=1
End DoDot:1
+5 QUIT ORY
+6 ;
SET(CODE,ORIEN) ;set the status of QO-ONLY to YES for a specific package type(CODE)
+1 NEW ORDA
+2 SET ORDA=$ORDER(^ORD(101.43,ORIEN,9,"B",CODE,""))
+3 IF ORDA
Begin DoDot:1
+4 NEW DA,DR,DIE
+5 SET DA(1)=ORIEN
SET DA=ORDA
SET DR=2_"///YES"
SET DIE="^ORD(101.43,"_DA(1)_",9,"
DO ^DIE
End DoDot:1
+6 QUIT
+7 ;
SURE(ORMSG) ; -- sure you want to delete?
+1 NEW X,Y,DIR
+2 SET DIR(0)="YA"
SET DIR("A")=" "_ORMSG_" "
+3 SET DIR("B")="NO"
WRITE $CHAR(7)
DO ^DIR
+4 if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
+6 ;
ERROR(ORERROR) ;
+1 WRITE !!,ORERROR
+2 WRITE !,"Please log a CA SDM ticket for assistance.",!
+3 HANG 2
+4 QUIT
+5 ;
ERRORFM(ORTEXT,ORERROR) ; Output FileMan Error Messages
+1 NEW ORX
+2 WRITE !!,"ERROR: "_ORTEXT_"."
+3 WRITE !,"VA FileMan Error #"_$GET(ORERROR("DIERR",1))_":"
+4 FOR ORX=1:1:+$ORDER(ORERROR("DIERR",1,"TEXT","A"),-1)
Begin DoDot:1
+5 WRITE !,$GET(ORERROR("DIERR",1,"TEXT",ORX))
End DoDot:1
+6 QUIT
