BDGLOC.m

BDGLOC ; IHS/ANMC/LJF - LOCATOR CARD ;  [ 08/20/2004  11:46 AM ]

 ;;5.3;PIMS;**1001,1003**;MAY 28, 2004

 ;IHS/ITSC/LJF 4/14/2005 PATCH 1003 default question to YES, if parameter turned on

 ;

NOPAT(BDGPRT) ;EP; entry point from menu

 NEW DFN,IEN

 S DFN=+$$READ^BDGF("PO^2:EMQZ","Select Patient") Q:DFN<1

 S IEN=$$ADMIT(DFN) Q:IEN<1

 D PAT(DFN,IEN,$S($G(BDGPRT)]"":BDGPRT,1:"A"))

 Q

 ;

PAT(DFN,BDGN,BDGPRT,BDGDEV) ;EP; entry point when patient is known

 ; can also be used as silent API

 ;  DFN=patient ien, required

 ;  BDGN = ien in file 405, movement entry, required

 ;  BDGPRT = 1 for print, 0 for not print, "A" for ask, required

 ;  BDGDEV = print device, required if silent call

 ;           if sent, automatic queuing to that device

 ;

 Q:'$G(DFN)  Q:'$G(BDGN)

 I $G(BDGPRT)="" S BDGPRT="A"

 I DGPMT=3,DGPMA]"" Q   ;no need when discharged

 ;

 ;IHS/ITSC/LJF 04/14/2005 PATCH 1003 if parameter turned on, assume they want to print

 ;I BDGPRT="A" S BDGPRT=$$READ^BDGF("Y","Print Locator Card","NO")

 I BDGPRT="A" S BDGPRT=$$READ^BDGF("Y","Print Locator Card","YES")

 ;

 Q:'BDGPRT     ;don't print

 ;

 ; if device sent, queue automatically

 I $G(BDGDEV)]"" D  Q

 . S ZTIO=BDGDEV,ZTRTN="EN^BDGLOC1",ZTDESC="Locator Card",ZTDTH=$H

 . F I="DFN","BDGN" S ZTSAVE(I)=""

 . D ^%ZTLOAD

 ;

 ; else, ask user

 ;IHS/ITSC/WAR 5/12/2004 P #1001 default LocCard Prt from ADT parameters

 ;D ZIS^BDGF("PQ","EN^BDGLOC1","Locator Card","DFN;BDGN",$G(BDGDEV))

 D ZIS^BDGF("PQ","EN^BDGLOC1","Locator Card","DFN;BDGN",$$GET1^DIQ(9009020.1,1,.04))

 Q

 ;

 ;

ADMIT(DFN) ; ask user to select an admission for patient

 I '$D(^DGPM("APCA",DFN)) W !!?5,"No admissions on file." Q 0

 ;

 ; loop by inverse date to display admissions with most recent first

 NEW IEN,IVDT,COUNT,ADM,Y

 W !!,"Admission(s)" S COUNT=0

 S IVDT=0 F  S IVDT=$O(^DGPM("ATID1",DFN,IVDT)) Q:'IVDT  D

 . S IEN=0 F  S IEN=$O(^DGPM("ATID1",DFN,IVDT,IEN)) Q:'IEN  D

 .. S COUNT=COUNT+1,ADM(COUNT)=IEN             ;save ien by count

 .. W !?5,COUNT,".  ",$$GET1^DIQ(405,IEN,.01)  ;display date by count

 ;

 I COUNT=1 Q ADM(1)     ;only one, no need to choose

 S Y=$$READ^BDGF("NO^1:"_COUNT,"Select One",1,"","")

 ;IHS/ITSC/WAR 5/12/2004 P #1001, need the array from list

 ;Q Y

 Q ADM(Y)

 ;

BDGLOC    ; IHS/ANMC/LJF - LOCATOR CARD ;  [ 08/20/2004  11:46 AM ]

 +1       ;;5.3;PIMS;**1001,1003**;MAY 28, 2004

 +2       ;IHS/ITSC/LJF 4/14/2005 PATCH 1003 default question to YES, if parameter turned on

 +3       ;

NOPAT(BDGPRT) ;EP; entry point from menu

 +1        NEW DFN,IEN

 +2        SET DFN=+$$READ^BDGF("PO^2:EMQZ","Select Patient")

           IF DFN<1

               QUIT 

 +3        SET IEN=$$ADMIT(DFN)

           IF IEN<1

               QUIT 

 +4        DO PAT(DFN,IEN,$SELECT($GET(BDGPRT)]"":BDGPRT,1:"A"))

 +5        QUIT 

 +6       ;

PAT(DFN,BDGN,BDGPRT,BDGDEV) ;EP; entry point when patient is known

 +1       ; can also be used as silent API

 +2       ;  DFN=patient ien, required

 +3       ;  BDGN = ien in file 405, movement entry, required

 +4       ;  BDGPRT = 1 for print, 0 for not print, "A" for ask, required

 +5       ;  BDGDEV = print device, required if silent call

 +6       ;           if sent, automatic queuing to that device

 +7       ;

 +8        IF '$GET(DFN)

               QUIT 

           IF '$GET(BDGN)

               QUIT 

 +9        IF $GET(BDGPRT)=""

               SET BDGPRT="A"

 +10      ;no need when discharged

           IF DGPMT=3

               IF DGPMA]""

                   QUIT 

 +11      ;

 +12      ;IHS/ITSC/LJF 04/14/2005 PATCH 1003 if parameter turned on, assume they want to print

 +13      ;I BDGPRT="A" S BDGPRT=$$READ^BDGF("Y","Print Locator Card","NO")

 +14       IF BDGPRT="A"

               SET BDGPRT=$$READ^BDGF("Y","Print Locator Card","YES")

 +15      ;

 +16      ;don't print

           IF 'BDGPRT

               QUIT 

 +17      ;

 +18      ; if device sent, queue automatically

 +19       IF $GET(BDGDEV)]""

               Begin DoDot:1

 +20               SET ZTIO=BDGDEV

                   SET ZTRTN="EN^BDGLOC1"

                   SET ZTDESC="Locator Card"

                   SET ZTDTH=$HOROLOG

 +21               FOR I="DFN","BDGN"

                       SET ZTSAVE(I)=""

 +22               DO ^%ZTLOAD

               End DoDot:1

               QUIT 

 +23      ;

 +24      ; else, ask user

 +25      ;IHS/ITSC/WAR 5/12/2004 P #1001 default LocCard Prt from ADT parameters

 +26      ;D ZIS^BDGF("PQ","EN^BDGLOC1","Locator Card","DFN;BDGN",$G(BDGDEV))

 +27       DO ZIS^BDGF("PQ","EN^BDGLOC1","Locator Card","DFN;BDGN",$$GET1^DIQ(9009020.1,1,.04))

 +28       QUIT 

 +29      ;

 +30      ;

ADMIT(DFN) ; ask user to select an admission for patient

 +1        IF '$DATA(^DGPM("APCA",DFN))

               WRITE !!?5,"No admissions on file."

               QUIT 0

 +2       ;

 +3       ; loop by inverse date to display admissions with most recent first

 +4        NEW IEN,IVDT,COUNT,ADM,Y

 +5        WRITE !!,"Admission(s)"

           SET COUNT=0

 +6        SET IVDT=0

           FOR 

               SET IVDT=$ORDER(^DGPM("ATID1",DFN,IVDT))

               IF 'IVDT

                   QUIT 

               Begin DoDot:1

 +7                SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^DGPM("ATID1",DFN,IVDT,IEN))

                       IF 'IEN

                           QUIT 

                       Begin DoDot:2

 +8       ;save ien by count

                           SET COUNT=COUNT+1

                           SET ADM(COUNT)=IEN

 +9       ;display date by count

                           WRITE !?5,COUNT,".  ",$$GET1^DIQ(405,IEN,.01)

                       End DoDot:2

               End DoDot:1

 +10      ;

 +11      ;only one, no need to choose

           IF COUNT=1

               QUIT ADM(1)

 +12       SET Y=$$READ^BDGF("NO^1:"_COUNT,"Select One",1,"","")

 +13      ;IHS/ITSC/WAR 5/12/2004 P #1001, need the array from list

 +14      ;Q Y

 +15       QUIT ADM(Y)

 +16      ;