BKMPLKP.m

BKMPLKP ;PRXM/HC/ALA - Patient Lookup ; 19 Jul 2005  12:32 PM

 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

 ;** Program Description **

 ;  This program contains a registry patient lookup as well as

 ;  a standard patient lookup

 ;

 Q

 ;

RLK(SCREEN) ;  EP - Registry Lookup

 K DFN,BKMRIEN,PTNAME,SEX,SSN,DOB,AUPNDOB,AGE,AUPNDOD,AUPNPAT,AUPNDAYS,AUPNSEX

 ;  Input Variable

 ;    SCREEN - any DIC("S") screen value

 ;

 ;  Output variables returned if patient selected

 ;    BKMRIEN - Registry IEN

 ;    DFN - Patient IEN

 ;    PTNAME - Patient Name

 ;    SEX - Patient Sex

 ;    SSN - Patient SSN

 ;    DOB - Patient Date of Birth

 ;    AUPNDOB - Patient Date of Birth

 ;    AGE - Patient Age

 ;    AUPNDOD - Patient Date of Death

 ;    AUPNPAT - Patient IEN

 ;    AUPNDAYS - Patient Age in # of Days

 ;

 NEW Y,X,DIC

 I $G(SCREEN)'="" S DIC("S")=SCREEN

 S DIC("A")="Registry Patient Name (HRN, DOB, SSN): ",DIC(0)="AEMQZ",DIC="^BKM(90451," D ^DIC

 I Y=-1 K SCREEN Q

 ;S DFN=+Y,BKMRIEN=$O(^BKM(90451,"B",DFN,"")),PTNAME=$P(^DPT(DFN,0),U,1)

 S BKMRIEN=+Y,DFN=$P(^BKM(90451,BKMRIEN,0),U,1),PTNAME=$P(^DPT(DFN,0),U,1)

 K SCREEN

 I $G(AUPNSEX)="" S Y=DFN D ^AUPNPAT K Y

 Q

 ;

PLK ;  EP - Patient Lookup

 K DFN,PTNAME,SEX,SSN,DOB,AUPNDOB,AGE,AUPNDOD,AUPNPAT,AUPNDAYS

 ;

 ;  Output variables returned if patient selected

 ;    DFN - Patient IEN

 ;    SEX - Patient Sex

 ;    SSN - Patient SSN

 ;    DOB - Patient Date of Birth

 ;    AUPNDOB - Patient Date of Birth

 ;    AGE - Patient Age

 ;    AUPNDOD - Patient Date of Death

 ;    AUPNPAT - Patient IEN

 ;    AUPNSEX - Patient Sex

 ;    AUPNDAYS - Patient Age in # of Days

 ;    PTNAME - Patient name

 ;

 NEW Y,X,DIC,DO

 ; PRX/HMS/DLS 3/30/2006 Added prompt to include HRN,DOB,SSN.

 S DIC("A")="Select Patient Name (HRN, DOB, SSN):"

 S DIC="^AUPNPAT(",DIC(0)="AEMQZ" D ^DIC

 S PTNAME=$G(Y(0,0))

 Q

 ;

PLKN(NDFN) ;  Non-interactive Patient Lookup

 ;

 ;  Input Parameter

 ;    NDFN - Patient IEN

 ;

 ;  Output Parameters

 ;    See list in PLK

 ;

 I $G(NDFN)="" Q

 NEW Y,X,DIC,DO

 S DIC="^AUPNPAT(",DIC(0)="MNQZ",X=NDFN D ^DIC

 K NDFN

 Q

BKMPLKP   ;PRXM/HC/ALA - Patient Lookup ; 19 Jul 2005  12:32 PM

 +1       ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

 +3       ;** Program Description **

 +4       ;  This program contains a registry patient lookup as well as

 +5       ;  a standard patient lookup

 +6       ;

 +7        QUIT 

 +8       ;

RLK(SCREEN) ;  EP - Registry Lookup

 +1        KILL DFN,BKMRIEN,PTNAME,SEX,SSN,DOB,AUPNDOB,AGE,AUPNDOD,AUPNPAT,AUPNDAYS,AUPNSEX

 +2       ;  Input Variable

 +3       ;    SCREEN - any DIC("S") screen value

 +4       ;

 +5       ;  Output variables returned if patient selected

 +6       ;    BKMRIEN - Registry IEN

 +7       ;    DFN - Patient IEN

 +8       ;    PTNAME - Patient Name

 +9       ;    SEX - Patient Sex

 +10      ;    SSN - Patient SSN

 +11      ;    DOB - Patient Date of Birth

 +12      ;    AUPNDOB - Patient Date of Birth

 +13      ;    AGE - Patient Age

 +14      ;    AUPNDOD - Patient Date of Death

 +15      ;    AUPNPAT - Patient IEN

 +16      ;    AUPNDAYS - Patient Age in # of Days

 +17      ;

 +18       NEW Y,X,DIC

 +19       IF $GET(SCREEN)'=""

               SET DIC("S")=SCREEN

 +20       SET DIC("A")="Registry Patient Name (HRN, DOB, SSN): "

           SET DIC(0)="AEMQZ"

           SET DIC="^BKM(90451,"

           DO ^DIC

 +21       IF Y=-1

               KILL SCREEN

               QUIT 

 +22      ;S DFN=+Y,BKMRIEN=$O(^BKM(90451,"B",DFN,"")),PTNAME=$P(^DPT(DFN,0),U,1)

 +23       SET BKMRIEN=+Y

           SET DFN=$PIECE(^BKM(90451,BKMRIEN,0),U,1)

           SET PTNAME=$PIECE(^DPT(DFN,0),U,1)

 +24       KILL SCREEN

 +25       IF $GET(AUPNSEX)=""

               SET Y=DFN

               DO ^AUPNPAT

               KILL Y

 +26       QUIT 

 +27      ;

PLK       ;  EP - Patient Lookup

 +1        KILL DFN,PTNAME,SEX,SSN,DOB,AUPNDOB,AGE,AUPNDOD,AUPNPAT,AUPNDAYS

 +2       ;

 +3       ;  Output variables returned if patient selected

 +4       ;    DFN - Patient IEN

 +5       ;    SEX - Patient Sex

 +6       ;    SSN - Patient SSN

 +7       ;    DOB - Patient Date of Birth

 +8       ;    AUPNDOB - Patient Date of Birth

 +9       ;    AGE - Patient Age

 +10      ;    AUPNDOD - Patient Date of Death

 +11      ;    AUPNPAT - Patient IEN

 +12      ;    AUPNSEX - Patient Sex

 +13      ;    AUPNDAYS - Patient Age in # of Days

 +14      ;    PTNAME - Patient name

 +15      ;

 +16       NEW Y,X,DIC,DO

 +17      ; PRX/HMS/DLS 3/30/2006 Added prompt to include HRN,DOB,SSN.

 +18       SET DIC("A")="Select Patient Name (HRN, DOB, SSN):"

 +19       SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQZ"

           DO ^DIC

 +20       SET PTNAME=$GET(Y(0,0))

 +21       QUIT 

 +22      ;

PLKN(NDFN) ;  Non-interactive Patient Lookup

 +1       ;

 +2       ;  Input Parameter

 +3       ;    NDFN - Patient IEN

 +4       ;

 +5       ;  Output Parameters

 +6       ;    See list in PLK

 +7       ;

 +8        IF $GET(NDFN)=""

               QUIT 

 +9        NEW Y,X,DIC,DO

 +10       SET DIC="^AUPNPAT("

           SET DIC(0)="MNQZ"

           SET X=NDFN

           DO ^DIC

 +11       KILL NDFN

 +12       QUIT