AUPNLKI.m

AUPNLKI ; IHS/CMI/LAB - IHS PATIENT LOOKUP, MAIN ROUTINE INITIALIZATION ; [ 12/05/00  8:56 AM ]

 ;;99.1;IHS DICTIONARIES (PATIENT);**5**;MAR 09, 1999;Build 9

 ;patch 5 fm v22

 ;

START ; INITIALIZATION

 S AUPQF=0,AUPDIC=DIC

 K AUPX,AUPDFN

 ;

 I '$D(DIC(0)) S AUPQF=1 Q

 I DIC(0)'["A"&('$D(X)) S AUPQF=1 Q

 I '$D(^DD("VERSION")) D:DIC(0)["E" EN^DDIOL("Unable to proceed. Fileman version node ^DD(""VERSION"") is undefined.","","!!?3") S AUPQF=1 Q

 I ^DD("VERSION")<17.2 D:DIC(0)["E" EN^DDIOL("Unable to proceed.  Fileman version must be at least 17.2.","","!!?3") S AUPQF=1 Q

 I '$D(^DPT(0)) D:DIC(0)["E" EN^DDIOL("Unable to proceed.  0th node of ^DPT missing.","","!!?3") S AUPQF=1 Q

 I '$D(^AUPNPAT(0)) D:DIC(0)["E" EN^DDIOL("Unable to proceed.  0th node of ^AUPNPAT missing.","","!!?3") S AUPQF=1 Q

 I '$D(DUZ(2)) D:DIC(0)["E" EN^DDIOL("Unable to proceed.  DUZ(2) is undefined.","","!!?3") S AUPQF=1 Q

 I DUZ(2)="" D:DIC(0)["E" EN^DDIOL("Unable to proceed.  DUZ(2) is NULL.","","!!?3") S AUPQF=1 Q

 I DUZ(2),'$D(^DIC(4,DUZ(2))) D:DIC(0)["E" EN^DDIOL("Unable to proceed.  DUZ(2) is not a valid Location.","","!!?3") S AUPQF=1 Q

 D:$D(AUPNLK("ALL")) SET^AUPNLKZ ; Undocumented feature

 ;

 ; - - - - - CHART # SCREEN - - - - -

 S:$D(DIC("S"))#2 AUPDICS=DIC("S")

 I DUZ(2) D SETDICS

 ; - - - - - SETUP DIC("W") - - - - -

 ; ** AUPNLKW overrides identifiers.  Must be set & killed by caller **

 K DUOUT,DTOUT S DIC="^DPT(" D DO^DIC1 S DIC("W")=$S($D(DIC("W")):DIC("W"),1:"") S:DIC("W")="W ""   "" D ^AUPNLKID"!(DIC("W")="") DIC("W")=$S($D(AUPNLKW):AUPNLKW,1:"D ^AUPNLKID")

 K AUPNLK("DICW")

 S:$L(DIC("W"))>110 AUPNLK("DICW")=DIC("W")

 S DIC("W")="D IHSDUPE^AUPNLKID "_$S($D(AUPNLK("DICW")):"X AUPNLK(""DICW"")",1:DIC("W"))

 S DIC("W")=DIC("W")_" N DA,X S DA=Y X $P(^DD(2,.081,0),U,5,99) D:X EN^DDIOL(""<Unresolved potential duplicate>"","""",""!?10"") W @(""$E(""_DIC_""Y,0),0)"")"

 S DIC("W")=DIC("W")_" I $D(AUPMAPY) S Y=AUPMAPY K AUPMAPY"

 S AUPDICW=DIC("W")

 Q

 ;

SETDICS ;SET DIC("S") NODES

 ;S DIC("S","IHSORIG")=$S($D(DIC("S")):DIC("S"),1:"I 1")

 S AUPNORIG=$S($D(DIC("S")):DIC("S"),1:"I 1")  ;IHS/ANMC/CLS 09/13/2000 fm v22

 ;S DIC("S","IHSLOOK")="I $D(^AUPNPAT(Y,41,DUZ(2),0))"_$S('$D(AUPNLK("INAC")):","_"$P(^(0),U,3)=""""",1:""),DIC("S")="X DIC(""S"",""IHSORIG"") I $T X DIC(""S"",""IHSLOOK"")"

 S AUPNLOOK="I $D(^AUPNPAT(Y,41,DUZ(2),0))"_$S('$D(AUPNLK("INAC")):","_"$P(^(0),U,3)=""""",1:""),DIC("S")="X AUPNORIG I $T X AUPNLOOK"  ;IHS/ANMC/CLS 09/13/2000 fm v22

 Q

AUPNLKI   ; IHS/CMI/LAB - IHS PATIENT LOOKUP, MAIN ROUTINE INITIALIZATION ; [ 12/05/00  8:56 AM ]

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);**5**;MAR 09, 1999;Build 9

 +2       ;patch 5 fm v22

 +3       ;

START     ; INITIALIZATION

 +1        SET AUPQF=0

           SET AUPDIC=DIC

 +2        KILL AUPX,AUPDFN

 +3       ;

 +4        IF '$DATA(DIC(0))

               SET AUPQF=1

               QUIT 

 +5        IF DIC(0)'["A"&('$DATA(X))

               SET AUPQF=1

               QUIT 

 +6        IF '$DATA(^DD("VERSION"))

               IF DIC(0)["E"

                   DO EN^DDIOL("Unable to proceed. Fileman version node ^DD(""VERSION"") is undefined.","","!!?3")

               SET AUPQF=1

               QUIT 

 +7        IF ^DD("VERSION")<17.2

               IF DIC(0)["E"

                   DO EN^DDIOL("Unable to proceed.  Fileman version must be at least 17.2.","","!!?3")

               SET AUPQF=1

               QUIT 

 +8        IF '$DATA(^DPT(0))

               IF DIC(0)["E"

                   DO EN^DDIOL("Unable to proceed.  0th node of ^DPT missing.","","!!?3")

               SET AUPQF=1

               QUIT 

 +9        IF '$DATA(^AUPNPAT(0))

               IF DIC(0)["E"

                   DO EN^DDIOL("Unable to proceed.  0th node of ^AUPNPAT missing.","","!!?3")

               SET AUPQF=1

               QUIT 

 +10       IF '$DATA(DUZ(2))

               IF DIC(0)["E"

                   DO EN^DDIOL("Unable to proceed.  DUZ(2) is undefined.","","!!?3")

               SET AUPQF=1

               QUIT 

 +11       IF DUZ(2)=""

               IF DIC(0)["E"

                   DO EN^DDIOL("Unable to proceed.  DUZ(2) is NULL.","","!!?3")

               SET AUPQF=1

               QUIT 

 +12       IF DUZ(2)

               IF '$DATA(^DIC(4,DUZ(2)))

                   IF DIC(0)["E"

                       DO EN^DDIOL("Unable to proceed.  DUZ(2) is not a valid Location.","","!!?3")

                   SET AUPQF=1

                   QUIT 

 +13      ; Undocumented feature

           IF $DATA(AUPNLK("ALL"))

               DO SET^AUPNLKZ

 +14      ;

 +15      ; - - - - - CHART # SCREEN - - - - -

 +16       IF $DATA(DIC("S"))#2

               SET AUPDICS=DIC("S")

 +17       IF DUZ(2)

               DO SETDICS

 +18      ; - - - - - SETUP DIC("W") - - - - -

 +19      ; ** AUPNLKW overrides identifiers.  Must be set & killed by caller **

 +20       KILL DUOUT,DTOUT

           SET DIC="^DPT("

           DO DO^DIC1

           SET DIC("W")=$SELECT($DATA(DIC("W")):DIC("W"),1:"")

           IF DIC("W")="W ""   "" D ^AUPNLKID"!(DIC("W")="")

               SET DIC("W")=$SELECT($DATA(AUPNLKW):AUPNLKW,1:"D ^AUPNLKID")

 +21       KILL AUPNLK("DICW")

 +22       IF $LENGTH(DIC("W"))>110

               SET AUPNLK("DICW")=DIC("W")

 +23       SET DIC("W")="D IHSDUPE^AUPNLKID "_$SELECT($DATA(AUPNLK("DICW")):"X AUPNLK(""DICW"")",1:DIC("W"))

 +24       SET DIC("W")=DIC("W")_" N DA,X S DA=Y X $P(^DD(2,.081,0),U,5,99) D:X EN^DDIOL(""<Unresolved potential duplicate>"","""",""!?10"") W @(""$E(""_DIC_""Y,0),0)"")"

 +25       SET DIC("W")=DIC("W")_" I $D(AUPMAPY) S Y=AUPMAPY K AUPMAPY"

 +26       SET AUPDICW=DIC("W")

 +27       QUIT 

 +28      ;

SETDICS   ;SET DIC("S") NODES

 +1       ;S DIC("S","IHSORIG")=$S($D(DIC("S")):DIC("S"),1:"I 1")

 +2       ;IHS/ANMC/CLS 09/13/2000 fm v22

           SET AUPNORIG=$SELECT($DATA(DIC("S")):DIC("S"),1:"I 1")

 +3       ;S DIC("S","IHSLOOK")="I $D(^AUPNPAT(Y,41,DUZ(2),0))"_$S('$D(AUPNLK("INAC")):","_"$P(^(0),U,3)=""""",1:""),DIC("S")="X DIC(""S"",""IHSORIG"") I $T X DIC(""S"",""IHSLOOK"")"

 +4       ;IHS/ANMC/CLS 09/13/2000 fm v22

           SET AUPNLOOK="I $D(^AUPNPAT(Y,41,DUZ(2),0))"_$SELECT('$DATA(AUPNLK("INAC")):","_"$P(^(0),U,3)=""""",1:"")

           SET DIC("S")="X AUPNORIG I $T X AUPNLOOK"

 +5        QUIT