AUPNLK1I.m

AUPNLK1I ; IHS/CMI/LAB - INITIALIZATION FOR ^AUPNLK1 ; [ 05/09/2003  8:00 AM ]

 ;;99.1;IHS DICTIONARIES (PATIENT);**2,9,10**;JUN 13, 2003;Build 9

 ;IHS/CMI/LAB - patch 2 Y2K

 ;

INIT ; INITIALIZATION - FIX UP AUPX AND SET UP XREFS

 I AUPX?.E1L.E F AUPI=1:1:$L(AUPX) S:$E(AUPX,AUPI)?1L AUPX=$E(AUPX,0,AUPI-1)_$C($A(AUPX,AUPI)-32)_$E(AUPX,AUPI+1,$L(AUPX))

 I AUPX[", " F AUPL=0:0 Q:'$F(AUPX,", ")  S AUPX=$E(AUPX,1,($F(AUPX,", ")-2))_$E(AUPX,$F(AUPX,", "),$L(AUPX))

 K AUPREFS S AUPREFS=$S(DIC(0)'["M":"B",AUPX?1A1N.N:$S($L(AUPX)<6:"CN,RM",1:"CN,RM"),AUPX?4N!(AUPX?4N1A):"SSN,CN,RM",AUPX?9N.E:"SSN,CN,RM",1:"")

 S:AUPREFS="" AUPREFS=$S(AUPX?1N.N:$S($L(AUPX)<5:"CN,RM,BS,SSN",1:"CN,RM,SSN"),AUPX?1N.E:"CN,RM",1:"B,CN,RM") S:$D(AUPIX) AUPREFS=AUPIX_","_AUPREFS

 ; - - - - - IHS DOB - - - - -

 ;beginning Y2K IHS/CMI/LAB

 ;change "X" to %DT="PX", change allowable input from 6N to 8N

 ;I DIC(0)["M",AUPX'?1N.N S %DT="X",X=$S(AUPX?1"B"6N:$E(AUPX,2,7),1:AUPX) D ^%DT S:Y'=-1 AUPDT=Y,AUPREFS=AUPREFS_",ADOB" K %DT,Y ;Y2000 IHS/CMI/LAB

 I DIC(0)["M",AUPX'?1N.N S %DT="PX",X=$S(AUPX?1"B"8N:$E(AUPX,2,9),1:AUPX) D ^%DT S:Y'=-1 AUPDT=Y,AUPREFS=AUPREFS_",ADOB" K %DT,Y ;Y2000 IHS/CMI/LAB

 ;end Y2K fix

 ; - - - - - IHS TEMPORARY CHART # - - - - -

 I AUPX?1"T"5N,$D(^AUPNPAT("D",AUPX)) S (AUPIFN,Y)=$O(^AUPNPAT("D",AUPX,0)) D SETAUP^AUPNLKUT

 ; - - - - - - - - - - - - - - - - - - - - -

 Q

AUPNLK1I  ; IHS/CMI/LAB - INITIALIZATION FOR ^AUPNLK1 ; [ 05/09/2003  8:00 AM ]

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);**2,9,10**;JUN 13, 2003;Build 9

 +2       ;IHS/CMI/LAB - patch 2 Y2K

 +3       ;

INIT      ; INITIALIZATION - FIX UP AUPX AND SET UP XREFS

 +1        IF AUPX?.E1L.E

               FOR AUPI=1:1:$LENGTH(AUPX)

                   IF $EXTRACT(AUPX,AUPI)?1L

                       SET AUPX=$EXTRACT(AUPX,0,AUPI-1)_$CHAR($ASCII(AUPX,AUPI)-32)_$EXTRACT(AUPX,AUPI+1,$LENGTH(AUPX))

 +2        IF AUPX[", "

               FOR AUPL=0:0

                   IF '$FIND(AUPX,", ")

                       QUIT 

                   SET AUPX=$EXTRACT(AUPX,1,($FIND(AUPX,", ")-2))_$EXTRACT(AUPX,$FIND(AUPX,", "),$LENGTH(AUPX))

 +3        KILL AUPREFS

           SET AUPREFS=$SELECT(DIC(0)'["M":"B",AUPX?1A1N.N:$SELECT($LENGTH(AUPX)<6:"CN,RM",1:"CN,RM"),AUPX?4N!(AUPX?4N1A):"SSN,CN,RM",AUPX?9N.E:"SSN,CN,RM",1:"")

 +4        IF AUPREFS=""

               SET AUPREFS=$SELECT(AUPX?1N.N:$SELECT($LENGTH(AUPX)<5:"CN,RM,BS,SSN",1:"CN,RM,SSN"),AUPX?1N.E:"CN,RM",1:"B,CN,RM")

           IF $DATA(AUPIX)

               SET AUPREFS=AUPIX_","_AUPREFS

 +5       ; - - - - - IHS DOB - - - - -

 +6       ;beginning Y2K IHS/CMI/LAB

 +7       ;change "X" to %DT="PX", change allowable input from 6N to 8N

 +8       ;I DIC(0)["M",AUPX'?1N.N S %DT="X",X=$S(AUPX?1"B"6N:$E(AUPX,2,7),1:AUPX) D ^%DT S:Y'=-1 AUPDT=Y,AUPREFS=AUPREFS_",ADOB" K %DT,Y ;Y2000 IHS/CMI/LAB

 +9       ;Y2000 IHS/CMI/LAB

           IF DIC(0)["M"

               IF AUPX'?1N.N

                   SET %DT="PX"

                   SET X=$SELECT(AUPX?1"B"8N:$EXTRACT(AUPX,2,9),1:AUPX)

                   DO ^%DT

                   IF Y'=-1

                       SET AUPDT=Y

                       SET AUPREFS=AUPREFS_",ADOB"

                   KILL %DT,Y

 +10      ;end Y2K fix

 +11      ; - - - - - IHS TEMPORARY CHART # - - - - -

 +12       IF AUPX?1"T"5N

               IF $DATA(^AUPNPAT("D",AUPX))

                   SET (AUPIFN,Y)=$ORDER(^AUPNPAT("D",AUPX,0))

                   DO SETAUP^AUPNLKUT

 +13      ; - - - - - - - - - - - - - - - - - - - - -

 +14       QUIT