Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOFDAUT

PSOFDAUT.m

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