- 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
