AQALDG51.m

AQALDG51 ; IHS/ORDC/LJF - AUTOLINK ADT OCCURRENCES ;

 ;;1;QI LINKAGES-RPMS;;AUG 15, 1994

 ;

 ;This rtn set the common variables & calls the PUBLISHED ENTRY POINT

 ;CREATE^AQALNK to create an occurrence.

 ;

FIND ; >>> find variables for autolink rtn

 K AQALIFN,AQALNKF,AQALNK ;kill occ ifn, error flags, input varbls

 G EXIT1:DFN="",EXIT1:'$D(^DPT(DFN,0)),EXIT1:$P(^(0),U,19)'=""

 S AQALNK("BUL")="AQAL ADT ERROR"

 S AQALNK("PAT")=DFN ;patient

 ;

 ; find indicator # for event

 K ^UTILITY("DIQ1",$J),DIQ

 S (AQALF,DIC)=9002166.4,DA=DUZ(2),DR=(AQALEV+1)_";"_(AQALEV+3)

 D EN^DIQ1 S X=^UTILITY("DIQ1",$J,AQALF,DA,AQALEV+1) G EXIT:X=""

 K DIC S DIC="^AQAO(2,",DIC(0)="" D ^DIC G EXIT:Y=-1

 S AQALNK("IND")=+Y,AQALNK("IND1")=$P(Y,U,2)

 ;

 ;get occurrence date

 S AQALNK("DATE")=$P(+DGPMA,".")

 G EXIT:AQALNK("DATE")=""

 ;

 ;get pcc visit (optional variable)

 S AQALNK("VSIT")=$P($G(^DGPM(DGPMCA,"IHS")),U)

 ;

 ;get hospital service linked to treating specialty

 S AQALNK("HSV")=AQALSV

 S X=$O(^AQAGP(DUZ(2),"SRV","B",AQALNK("HSV"),0)) G EXIT1:X=""

 Q:$P($G(^AQAGP(DUZ(2),"SRV",X,0)),U,($E(AQALEV,3)+2))'=1  ;srv not lnkd

 ;

 ;get ward name

 S X=$S($D(AQALWD):AQALWD,1:$P(DGPMA,U,6)) G EXIT:X=""

 S AQALNK("WARD")=$S(X="":"",1:$P($G(^DIC(42,X,44)),U))

 ;

 ;get facility #

 G EXIT:'$D(DUZ(2)) S AQALNK("FAC")=DUZ(2)

 ;

 ;get duplicate flag (yes=okay to create duplicate entry)

 S AQALNK("DUP OK")=^UTILITY("DIQ1",$J,AQALF,DUZ(2),AQALEV+3)

 I AQALNK("DUP OK")'="YES" K AQALNK("DUP OK")

 K ^UTILITY("DIQ1",$J)

 ;

 ;

CREATE ; >>> call ^aqalnk to create occurrence

 I $D(AQALAUT(AQALNK("IND1"))) D  I 1

 .I DGPMT=2 S AQALNK("OCC")=$O(^AQAOC("AA",AQALNK("IND"),AQALNK("DATE"),AQALNK("PAT"),0))

 .I DGPMT'=2 S AQALNK("OCC")=AQALAUT(AQALNK("IND1"))

 .I +AQALNK("OCC") D EDIT^AQALNK1 I 1

 .E  D CREATE^AQALNK

 E  D CREATE^AQALNK

 ;

 ;

EXIT ; >>> eoj

 I '$D(AQALIFN),'$D(AQALNKF) W !!,*7,"ERROR IN QI PARAMETER FILE OR IN ADT CALL TO ^AQALDG5. CALL YOUR SITE MANAGER.",!!

EXIT1 K ^UTILITY("DIQ1",$J)

 K DIC,X,Y

 K AQALAUT(AQALNK("IND1"))

 Q

AQALDG51  ; IHS/ORDC/LJF - AUTOLINK ADT OCCURRENCES ;

 +1       ;;1;QI LINKAGES-RPMS;;AUG 15, 1994

 +2       ;

 +3       ;This rtn set the common variables & calls the PUBLISHED ENTRY POINT

 +4       ;CREATE^AQALNK to create an occurrence.

 +5       ;

FIND      ; >>> find variables for autolink rtn

 +1       ;kill occ ifn, error flags, input varbls

           KILL AQALIFN,AQALNKF,AQALNK

 +2        IF DFN=""

               GOTO EXIT1

           IF '$DATA(^DPT(DFN,0))

               GOTO EXIT1

           IF $PIECE(^(0),U,19)'=""

               GOTO EXIT1

 +3        SET AQALNK("BUL")="AQAL ADT ERROR"

 +4       ;patient

           SET AQALNK("PAT")=DFN

 +5       ;

 +6       ; find indicator # for event

 +7        KILL ^UTILITY("DIQ1",$JOB),DIQ

 +8        SET (AQALF,DIC)=9002166.4

           SET DA=DUZ(2)

           SET DR=(AQALEV+1)_";"_(AQALEV+3)

 +9        DO EN^DIQ1

           SET X=^UTILITY("DIQ1",$JOB,AQALF,DA,AQALEV+1)

           IF X=""

               GOTO EXIT

 +10       KILL DIC

           SET DIC="^AQAO(2,"

           SET DIC(0)=""

           DO ^DIC

           IF Y=-1

               GOTO EXIT

 +11       SET AQALNK("IND")=+Y

           SET AQALNK("IND1")=$PIECE(Y,U,2)

 +12      ;

 +13      ;get occurrence date

 +14       SET AQALNK("DATE")=$PIECE(+DGPMA,".")

 +15       IF AQALNK("DATE")=""

               GOTO EXIT

 +16      ;

 +17      ;get pcc visit (optional variable)

 +18       SET AQALNK("VSIT")=$PIECE($GET(^DGPM(DGPMCA,"IHS")),U)

 +19      ;

 +20      ;get hospital service linked to treating specialty

 +21       SET AQALNK("HSV")=AQALSV

 +22       SET X=$ORDER(^AQAGP(DUZ(2),"SRV","B",AQALNK("HSV"),0))

           IF X=""

               GOTO EXIT1

 +23      ;srv not lnkd

           IF $PIECE($GET(^AQAGP(DUZ(2),"SRV",X,0)),U,($EXTRACT(AQALEV,3)+2))'=1

               QUIT 

 +24      ;

 +25      ;get ward name

 +26       SET X=$SELECT($DATA(AQALWD):AQALWD,1:$PIECE(DGPMA,U,6))

           IF X=""

               GOTO EXIT

 +27       SET AQALNK("WARD")=$SELECT(X="":"",1:$PIECE($GET(^DIC(42,X,44)),U))

 +28      ;

 +29      ;get facility #

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

               GOTO EXIT

           SET AQALNK("FAC")=DUZ(2)

 +31      ;

 +32      ;get duplicate flag (yes=okay to create duplicate entry)

 +33       SET AQALNK("DUP OK")=^UTILITY("DIQ1",$JOB,AQALF,DUZ(2),AQALEV+3)

 +34       IF AQALNK("DUP OK")'="YES"

               KILL AQALNK("DUP OK")

 +35       KILL ^UTILITY("DIQ1",$JOB)

 +36      ;

 +37      ;

CREATE    ; >>> call ^aqalnk to create occurrence

 +1        IF $DATA(AQALAUT(AQALNK("IND1")))

               Begin DoDot:1

 +2                IF DGPMT=2

                       SET AQALNK("OCC")=$ORDER(^AQAOC("AA",AQALNK("IND"),AQALNK("DATE"),AQALNK("PAT"),0))

 +3                IF DGPMT'=2

                       SET AQALNK("OCC")=AQALAUT(AQALNK("IND1"))

 +4                IF +AQALNK("OCC")

                       DO EDIT^AQALNK1

                       IF 1

 +5               IF '$TEST

                       DO CREATE^AQALNK

               End DoDot:1

               IF 1

 +6       IF '$TEST

               DO CREATE^AQALNK

 +7       ;

 +8       ;

EXIT      ; >>> eoj

 +1        IF '$DATA(AQALIFN)

               IF '$DATA(AQALNKF)

                   WRITE !!,*7,"ERROR IN QI PARAMETER FILE OR IN ADT CALL TO ^AQALDG5. CALL YOUR SITE MANAGER.",!!

EXIT1      KILL ^UTILITY("DIQ1",$JOB)

 +1        KILL DIC,X,Y

 +2        KILL AQALAUT(AQALNK("IND1"))

 +3        QUIT