- PSOFDAUT ;BIRM/MFR - FDA Med Guide Utilities ; 07 Jun 2005 8:39 PM
- ;;7.0;OUTPATIENT PHARMACY;**367**;DEC 1997;Build 62
- ;External reference to $$FDAMG^PSNAPIS supported by DBIA 2531
- ;
- SELPRT(DEFAULT) ; FDA Med Guide Printer Selection
- ;Input: DEFAULT - Default Printer Name
- ;Return Variable: SELPRT: Selected Printer Name ^ Windows Network Printer Name
- ;
- N SELPRT,NTWRKNAM,DEFPRT,%ZIS,VALID,DEVIEN,PRTLST,I
- ;
- ; If FDA MG PRINT SERVER is not present quits (FDA MG Functionality is OFF)
- I $$GET1^DIQ(59,PSOSITE,134)="" Q "^"
- ;
- S SELPRT=$G(DEFAULT) D ^%ZISC
- I SELPRT'="" D
- . S DEFPRT=SELPRT
- E D
- . S DEFPRT=$$DEFPRT(PSOSITE)
- ;
- D PRTLST(PSOSITE,.PRTLST)
- I $O(PRTLST(0)) D
- . W !!,$$GET1^DIQ(59,PSOSITE,.01),"'s FDA Medication Guide Printer(s) on file:",!
- . F I=0:0 S I=$O(PRTLST(I)) Q:'I W !?5,$P(PRTLST(I),"^",2)
- ;
- PRT ; Printer prompt
- S %ZIS="MNQ",%ZIS("A")="Select FDA MED GUIDE PRINTER: "
- S:$G(DEFPRT)'="" %ZIS("B")=$P(DEFPRT,"^") W ! D ^%ZIS K %ZIS,IO("Q"),IOP I POP Q "^"
- S VALID=1
- I (IO'=IO(0)) D I 'VALID D ^%ZISC G PRT
- . S DEVIEN=IOS,NTWRKNAM=$$GET1^DIQ(3.5,IOS,75)
- . I (NTWRKNAM=""&(" "_ION_" "'[" NULL ")) D S VALID=0 Q
- . . W !,"This device cannot be used for printing FDA Medication Guides."
- . . W !,"Please, contact your IRM and ask them to update the Windows"
- . . W !,"Network Printer Name for this device.",$C(7)
- . E D
- . . S SELPRT=ION_"^"_NTWRKNAM
- ;
- ; HOME device selected
- I (IO=IO(0)) S SELPRT=""
- ;
- D ^%ZISC
- ;
- Q SELPRT
- ;
- PRTLST(SITE,PRTLST) ; Returns the List of FDA Medication Guide Printer for the Division
- ; Input: (r) SITE - Site IEN (#59)
- ; Output: PRTLST - Array containing list of FDA Med Guides Printers for the Division
- N PRT,CNT
- S CNT=0
- F PRT=0:0 S PRT=$O(^PS(59,+$G(SITE),"FDA",PRT)) Q:'PRT D
- . S CNT=CNT+1
- . S PRTLST(CNT)=$$GET1^DIQ(59.0135,PRT_","_+$G(SITE)_",",.01)_"^"_$$GET1^DIQ(59.0135,PRT_","_+$G(SITE)_",",.01)
- . S:$$GET1^DIQ(59.0135,PRT_","_+$G(SITE)_",",.02,"I") PRTLST(CNT)=PRTLST(CNT)_" (Default)"
- Q
- ;
- DEFPRT(SITE) ; Returns the Default FDA Medication Guide Printer for the Division
- ; Input: (r) SITE - Site IEN (#59)
- ; Output: DEFPRT - Device Name or blank (no Default)
- N PRT,DEFPRT
- S DEFPRT=""
- F PRT=0:0 S PRT=$O(^PS(59,+$G(SITE),"FDA",PRT)) Q:'PRT D
- . I $P($G(^PS(59,+$G(SITE),"FDA",PRT,0)),"^",2) D
- . . S PRTIEN=$$GET1^DIQ(59.0135,PRT_","_+$G(SITE)_",",.01,"I") I 'PRTIEN Q
- . . I $$GET1^DIQ(3.5,PRTIEN,75)="" Q
- . . S DEFPRT=$$GET1^DIQ(3.5,PRTIEN,.01)_"^"_$$GET1^DIQ(3.5,PRTIEN,75)
- Q DEFPRT
- ;
- FDAMGDOC(RXIEN) ; Lists all FDA Med Guides for a specific Rx & Return Selection
- ; Input: (r) RXIEN - Prescription IEN (#52)
- ; Output: FDAMGDOC - FDA Med Guide PDF file name or blank, "^" (no selection)
- ;
- ASK ; Prompt for FDA Medication Guide Selection
- N MGLST,DIR,DIRUT,DUOUT,DTOUT
- D FDAMGLST(RXIEN,1,.MGLST) D HELP W !
- S DIR(0)="FO",DIR("A")="Select FDA Med Guide (1-"_$O(MGLST(999),-1)_")"
- S (DIR("?"),DIR("??"))="^D HELP^PSOFDAUT" D ^DIR
- I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) Q "^"
- I '$D(MGLST(X)) W ?40,"Invalid selection.",$C(7) G ASK
- W " ",$P(MGLST(X),"^",2)
- Q $P(MGLST(X),"^",2)
- ;
- HELP ; List FDA Med Guides and prompt for selection
- N INDEX,XX
- S XX="",$P(XX,"-",81)=""
- W !,XX,!," # FL",?7,"FDA MED GUIDE FILE NAME",?64,"TYPE",?72,"DATE",!,XX
- S INDEX=0 F S INDEX=$O(MGLST(INDEX)) Q:'INDEX D
- . W:'$O(MGLST(INDEX)) !
- . W !,$J(INDEX,2),?3,$J($P(MGLST(INDEX),"^"),2),?7,$P(MGLST(INDEX),"^",2)
- . W ?64,$P(MGLST(INDEX),"^",3),?72,$P(MGLST(INDEX),"^",4)
- Q
- ;
- FDAMGLST(RXIEN,ADDLST,MGLST) ; Return a list of all FDA Med Guides for a specific Rx
- ; Input: (r) RXIEN - Prescription IEN (#52)
- ; (o) ADDLST - Add Latest FDA Med Guide to the list? (Default: 0 (No))
- ; Output: MGLST - Array containing list of FDA Med Guides for the Rx (By Reference)
- N A,B,Z,LBL,CMP,FDAMG,RFL,DRGIEN,NDFIEN,FILL,INDEX,TMPLST,MGDATE
- ;
- K TMPLST
- ; Window Fills
- S LBL=0 F S LBL=$O(^PSRX(RXIEN,"L",LBL)) Q:'LBL D
- . S FDAMG=$G(^PSRX(RXIEN,"L",LBL,"FDA")) I FDAMG="" Q
- . S Z=$G(^PSRX(RXIEN,"L",LBL,0)) S FILL=+$P(Z,"^",2) I (FILL>20) S FILL="P"_(99-FILL)
- . S MGDATE=$$GET1^DIQ(52.032,LBL_","_RXIEN_",",.01,"I")\1
- . S TMPLST(MGDATE,FILL)=FILL_"^"_FDAMG_"^"_$S(FILL["P":"PARTIAL",1:"WINDOW")_"^"_$$FMTE^XLFDT(MGDATE,"2ZM")
- ;
- ; CMOP Fills
- S CMP=0 F S CMP=$O(^PSRX(RXIEN,4,CMP)) Q:'CMP D
- . S FDAMG=$G(^PSRX(RXIEN,4,CMP,"FDA")) I FDAMG="" Q
- . S Z=$G(^PSRX(RXIEN,4,CMP,0)) Q:'+Z
- . S MGDATE=$$GET1^DIQ(550.2,+Z,5,"I")\1
- . S TMPLST(MGDATE,+$P(Z,"^",3))=+$P(Z,"^",3)_"^"_FDAMG_"^CMOP^"_$$FMTE^XLFDT(MGDATE,"2ZM")
- ;
- ; - Moving from TMPLST to MGLST
- K MGLST S INDEX=0,(A,B)=""
- F S A=$O(TMPLST(A)) Q:A="" F S B=$O(TMPLST(A,B)) Q:B="" D
- . S INDEX=INDEX+1,MGLST(INDEX)=TMPLST(A,B)
- ;
- ; - Adding 'LATEST' FDA Med Guide
- I $G(ADDLST) D
- . S DRGIEN=$$GET1^DIQ(52,RXIEN,6,"I"),NDFIEN=$$GET1^DIQ(50,DRGIEN,22,"I")
- . I ($$FDAMG^PSNAPIS(NDFIEN)'="") D
- . . S INDEX=INDEX+1,MGLST(INDEX)="^"_$$FDAMG^PSNAPIS(NDFIEN)_"^LATEST"
- ;
- Q
- ;
- MGONFILE(RXIEN) ; Is there an FDA Med Guide on File for the Prescription
- ; Input: (r) RXIEN - Pointer to the PRESCRIPTION file (#52)
- ;Output: 1^FDA Med Guide Document Name / 0 (no)
- ;
- N DRGIEN,NDFIEN,FDAMGFN
- I '$D(^PSRX(RXIEN)) Q 0
- S DRGIEN=$P($G(^PSRX(RXIEN,0)),"^",6)
- I '$D(^PSDRUG(DRGIEN)) Q 0
- S NDFIEN=+$P($G(^PSDRUG(DRGIEN,"ND")),"^",3) I 'NDFIEN Q 0
- S FDAMGFN=$$FDAMG^PSNAPIS(NDFIEN) I FDAMGFN="" Q 0
- Q ("1^"_FDAMGFN)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOFDAUT 5540 printed Feb 18, 2025@23:55:50 Page 2
- PSOFDAUT ;BIRM/MFR - FDA Med Guide Utilities ; 07 Jun 2005 8:39 PM
- +1 ;;7.0;OUTPATIENT PHARMACY;**367**;DEC 1997;Build 62
- +2 ;External reference to $$FDAMG^PSNAPIS supported by DBIA 2531
- +3 ;
- SELPRT(DEFAULT) ; FDA Med Guide Printer Selection
- +1 ;Input: DEFAULT - Default Printer Name
- +2 ;Return Variable: SELPRT: Selected Printer Name ^ Windows Network Printer Name
- +3 ;
- +4 NEW SELPRT,NTWRKNAM,DEFPRT,%ZIS,VALID,DEVIEN,PRTLST,I
- +5 ;
- +6 ; If FDA MG PRINT SERVER is not present quits (FDA MG Functionality is OFF)
- +7 IF $$GET1^DIQ(59,PSOSITE,134)=""
- QUIT "^"
- +8 ;
- +9 SET SELPRT=$GET(DEFAULT)
- DO ^%ZISC
- +10 IF SELPRT'=""
- Begin DoDot:1
- +11 SET DEFPRT=SELPRT
- End DoDot:1
- +12 IF '$TEST
- Begin DoDot:1
- +13 SET DEFPRT=$$DEFPRT(PSOSITE)
- End DoDot:1
- +14 ;
- +15 DO PRTLST(PSOSITE,.PRTLST)
- +16 IF $ORDER(PRTLST(0))
- Begin DoDot:1
- +17 WRITE !!,$$GET1^DIQ(59,PSOSITE,.01),"'s FDA Medication Guide Printer(s) on file:",!
- +18 FOR I=0:0
- SET I=$ORDER(PRTLST(I))
- if 'I
- QUIT
- WRITE !?5,$PIECE(PRTLST(I),"^",2)
- End DoDot:1
- +19 ;
- PRT ; Printer prompt
- +1 SET %ZIS="MNQ"
- SET %ZIS("A")="Select FDA MED GUIDE PRINTER: "
- +2 if $GET(DEFPRT)'=""
- SET %ZIS("B")=$PIECE(DEFPRT,"^")
- WRITE !
- DO ^%ZIS
- KILL %ZIS,IO("Q"),IOP
- IF POP
- QUIT "^"
- +3 SET VALID=1
- +4 IF (IO'=IO(0))
- Begin DoDot:1
- +5 SET DEVIEN=IOS
- SET NTWRKNAM=$$GET1^DIQ(3.5,IOS,75)
- +6 IF (NTWRKNAM=""&(" "_ION_" "'[" NULL "))
- Begin DoDot:2
- +7 WRITE !,"This device cannot be used for printing FDA Medication Guides."
- +8 WRITE !,"Please, contact your IRM and ask them to update the Windows"
- +9 WRITE !,"Network Printer Name for this device.",$CHAR(7)
- End DoDot:2
- SET VALID=0
- QUIT
- +10 IF '$TEST
- Begin DoDot:2
- +11 SET SELPRT=ION_"^"_NTWRKNAM
- End DoDot:2
- End DoDot:1
- IF 'VALID
- DO ^%ZISC
- GOTO PRT
- +12 ;
- +13 ; HOME device selected
- +14 IF (IO=IO(0))
- SET SELPRT=""
- +15 ;
- +16 DO ^%ZISC
- +17 ;
- +18 QUIT SELPRT
- +19 ;
- PRTLST(SITE,PRTLST) ; Returns the List of FDA Medication Guide Printer for the Division
- +1 ; Input: (r) SITE - Site IEN (#59)
- +2 ; Output: PRTLST - Array containing list of FDA Med Guides Printers for the Division
- +3 NEW PRT,CNT
- +4 SET CNT=0
- +5 FOR PRT=0:0
- SET PRT=$ORDER(^PS(59,+$GET(SITE),"FDA",PRT))
- if 'PRT
- QUIT
- Begin DoDot:1
- +6 SET CNT=CNT+1
- +7 SET PRTLST(CNT)=$$GET1^DIQ(59.0135,PRT_","_+$GET(SITE)_",",.01)_"^"_$$GET1^DIQ(59.0135,PRT_","_+$GET(SITE)_",",.01)
- +8 if $$GET1^DIQ(59.0135,PRT_","_+$GET(SITE)_",",.02,"I")
- SET PRTLST(CNT)=PRTLST(CNT)_" (Default)"
- End DoDot:1
- +9 QUIT
- +10 ;
- DEFPRT(SITE) ; Returns the Default FDA Medication Guide Printer for the Division
- +1 ; Input: (r) SITE - Site IEN (#59)
- +2 ; Output: DEFPRT - Device Name or blank (no Default)
- +3 NEW PRT,DEFPRT
- +4 SET DEFPRT=""
- +5 FOR PRT=0:0
- SET PRT=$ORDER(^PS(59,+$GET(SITE),"FDA",PRT))
- if 'PRT
- QUIT
- Begin DoDot:1
- +6 IF $PIECE($GET(^PS(59,+$GET(SITE),"FDA",PRT,0)),"^",2)
- Begin DoDot:2
- +7 SET PRTIEN=$$GET1^DIQ(59.0135,PRT_","_+$GET(SITE)_",",.01,"I")
- IF 'PRTIEN
- QUIT
- +8 IF $$GET1^DIQ(3.5,PRTIEN,75)=""
- QUIT
- +9 SET DEFPRT=$$GET1^DIQ(3.5,PRTIEN,.01)_"^"_$$GET1^DIQ(3.5,PRTIEN,75)
- End DoDot:2
- End DoDot:1
- +10 QUIT DEFPRT
- +11 ;
- FDAMGDOC(RXIEN) ; Lists all FDA Med Guides for a specific Rx & Return Selection
- +1 ; Input: (r) RXIEN - Prescription IEN (#52)
- +2 ; Output: FDAMGDOC - FDA Med Guide PDF file name or blank, "^" (no selection)
- +3 ;
- ASK ; Prompt for FDA Medication Guide Selection
- +1 NEW MGLST,DIR,DIRUT,DUOUT,DTOUT
- +2 DO FDAMGLST(RXIEN,1,.MGLST)
- DO HELP
- WRITE !
- +3 SET DIR(0)="FO"
- SET DIR("A")="Select FDA Med Guide (1-"_$ORDER(MGLST(999),-1)_")"
- +4 SET (DIR("?"),DIR("??"))="^D HELP^PSOFDAUT"
- DO ^DIR
- +5 IF $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)
- QUIT "^"
- +6 IF '$DATA(MGLST(X))
- WRITE ?40,"Invalid selection.",$CHAR(7)
- GOTO ASK
- +7 WRITE " ",$PIECE(MGLST(X),"^",2)
- +8 QUIT $PIECE(MGLST(X),"^",2)
- +9 ;
- HELP ; List FDA Med Guides and prompt for selection
- +1 NEW INDEX,XX
- +2 SET XX=""
- SET $PIECE(XX,"-",81)=""
- +3 WRITE !,XX,!," # FL",?7,"FDA MED GUIDE FILE NAME",?64,"TYPE",?72,"DATE",!,XX
- +4 SET INDEX=0
- FOR
- SET INDEX=$ORDER(MGLST(INDEX))
- if 'INDEX
- QUIT
- Begin DoDot:1
- +5 if '$ORDER(MGLST(INDEX))
- WRITE !
- +6 WRITE !,$JUSTIFY(INDEX,2),?3,$JUSTIFY($PIECE(MGLST(INDEX),"^"),2),?7,$PIECE(MGLST(INDEX),"^",2)
- +7 WRITE ?64,$PIECE(MGLST(INDEX),"^",3),?72,$PIECE(MGLST(INDEX),"^",4)
- End DoDot:1
- +8 QUIT
- +9 ;
- FDAMGLST(RXIEN,ADDLST,MGLST) ; Return a list of all FDA Med Guides for a specific Rx
- +1 ; Input: (r) RXIEN - Prescription IEN (#52)
- +2 ; (o) ADDLST - Add Latest FDA Med Guide to the list? (Default: 0 (No))
- +3 ; Output: MGLST - Array containing list of FDA Med Guides for the Rx (By Reference)
- +4 NEW A,B,Z,LBL,CMP,FDAMG,RFL,DRGIEN,NDFIEN,FILL,INDEX,TMPLST,MGDATE
- +5 ;
- +6 KILL TMPLST
- +7 ; Window Fills
- +8 SET LBL=0
- FOR
- SET LBL=$ORDER(^PSRX(RXIEN,"L",LBL))
- if 'LBL
- QUIT
- Begin DoDot:1
- +9 SET FDAMG=$GET(^PSRX(RXIEN,"L",LBL,"FDA"))
- IF FDAMG=""
- QUIT
- +10 SET Z=$GET(^PSRX(RXIEN,"L",LBL,0))
- SET FILL=+$PIECE(Z,"^",2)
- IF (FILL>20)
- SET FILL="P"_(99-FILL)
- +11 SET MGDATE=$$GET1^DIQ(52.032,LBL_","_RXIEN_",",.01,"I")\1
- +12 SET TMPLST(MGDATE,FILL)=FILL_"^"_FDAMG_"^"_$SELECT(FILL["P":"PARTIAL",1:"WINDOW")_"^"_$$FMTE^XLFDT(MGDATE,"2ZM")
- End DoDot:1
- +13 ;
- +14 ; CMOP Fills
- +15 SET CMP=0
- FOR
- SET CMP=$ORDER(^PSRX(RXIEN,4,CMP))
- if 'CMP
- QUIT
- Begin DoDot:1
- +16 SET FDAMG=$GET(^PSRX(RXIEN,4,CMP,"FDA"))
- IF FDAMG=""
- QUIT
- +17 SET Z=$GET(^PSRX(RXIEN,4,CMP,0))
- if '+Z
- QUIT
- +18 SET MGDATE=$$GET1^DIQ(550.2,+Z,5,"I")\1
- +19 SET TMPLST(MGDATE,+$PIECE(Z,"^",3))=+$PIECE(Z,"^",3)_"^"_FDAMG_"^CMOP^"_$$FMTE^XLFDT(MGDATE,"2ZM")
- End DoDot:1
- +20 ;
- +21 ; - Moving from TMPLST to MGLST
- +22 KILL MGLST
- SET INDEX=0
- SET (A,B)=""
- +23 FOR
- SET A=$ORDER(TMPLST(A))
- if A=""
- QUIT
- FOR
- SET B=$ORDER(TMPLST(A,B))
- if B=""
- QUIT
- Begin DoDot:1
- +24 SET INDEX=INDEX+1
- SET MGLST(INDEX)=TMPLST(A,B)
- End DoDot:1
- +25 ;
- +26 ; - Adding 'LATEST' FDA Med Guide
- +27 IF $GET(ADDLST)
- Begin DoDot:1
- +28 SET DRGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
- SET NDFIEN=$$GET1^DIQ(50,DRGIEN,22,"I")
- +29 IF ($$FDAMG^PSNAPIS(NDFIEN)'="")
- Begin DoDot:2
- +30 SET INDEX=INDEX+1
- SET MGLST(INDEX)="^"_$$FDAMG^PSNAPIS(NDFIEN)_"^LATEST"
- End DoDot:2
- End DoDot:1
- +31 ;
- +32 QUIT
- +33 ;
- MGONFILE(RXIEN) ; Is there an FDA Med Guide on File for the Prescription
- +1 ; Input: (r) RXIEN - Pointer to the PRESCRIPTION file (#52)
- +2 ;Output: 1^FDA Med Guide Document Name / 0 (no)
- +3 ;
- +4 NEW DRGIEN,NDFIEN,FDAMGFN
- +5 IF '$DATA(^PSRX(RXIEN))
- QUIT 0
- +6 SET DRGIEN=$PIECE($GET(^PSRX(RXIEN,0)),"^",6)
- +7 IF '$DATA(^PSDRUG(DRGIEN))
- QUIT 0
- +8 SET NDFIEN=+$PIECE($GET(^PSDRUG(DRGIEN,"ND")),"^",3)
- IF 'NDFIEN
- QUIT 0
- +9 SET FDAMGFN=$$FDAMG^PSNAPIS(NDFIEN)
- IF FDAMGFN=""
- QUIT 0
- +10 QUIT ("1^"_FDAMGFN)