SD5360PT ;ALB/REW - SD*5.3*60 Post-installation ; 10-DEC-1996
;;5.3;Scheduling;**60,132**;SEP 25, 1993
;
EN ;entry point
;search TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75) to find
;rejected encounters of type #510 -'Diagnosis Priority is not 1 or null
;if there is only one diagnosis associated with the encounter, the
;diagnosis will be marked as 'primary' in the V POV file
; (#9000010.07) and the encounter will be re-transmitted
;
D INTRO
D SEARCH
D EXIT
Q
;
INTRO ;header info for output
D MES^XPDUTL(">>>Searching TRANSMITTED OUTPATIENT ENCOUNTER ERROR File (#409.75)")
D MES^XPDUTL(" for error code=510 (Diagnosis Priority is not '1' or null.)")
D MES^XPDUTL(" All such encounters will be displayed.")
D BMES^XPDUTL(" If there is exactly one DX for an encounter, it will be marked as primary")
D MES^XPDUTL(" and the encounter marked for nightly transmission to Austin (NPCDB).")
D MES^XPDUTL("")
Q
SEARCH ;look for TRANSMITTED OUTPATIENT ENCOUNTER ENTRIES with error code 510
; SC40975 = ien of TRANSMITTED OUTPATIENT ENCOUNTER ERROR (#409.75)
; SC40943 = ien of OUTPATIENT DIAGNOSIS (#409.43)
; SCNODE = zero node of #409.75
; SCENODE = zero node of #409.68
; SCPTR = ptr value for error code for value of '510'
N SCE,SCNONE,SC40975,SCNODE,SCPTR,SC40973
S SCNONE=1
S SCPTR=$O(^SD(409.76,"B","510",0))
IF 'SCPTR D Q
.D BMES^XPDUTL(">>> Missing Cross-Reference for code 510 in file 409.76. Aborting")
S SC40975=0
F S SC40975=$O(^SD(409.75,SC40975)) Q:'SC40975 S SCNODE=$G(^(SC40975,0)) D
.N SCDXDX,SC40943,SCENODE,SCDATE,Y
.Q:$P(SCNODE,U,2)'=SCPTR ;must be #510 error
.S SCE=$P($G(^SD(409.73,+$P(SCNODE,U,1),0)),U,2) ;null or 409.68 ptr
.;quit if a deleted encounter
.Q:'SCE
.S SCENODE=$G(^SCE(SCE,0))
.IF ('$P(SCENODE,U,1))!('$P(SCENODE,U,2)) D Q
..D BMES^XPDUTL(" File #409.68 ien: "_SCE_" Corrupt/Missing")
..D MES^XPDUTL(" File #409.68 zero node: "_SCENODE)
.S Y=+SCENODE D DD^%DT S SCDATE=Y
.S SCNONE=0
.D MES^XPDUTL(" File #409.68 ien: "_SCE_" "_$P(^DPT($P(SCENODE,U,2),0),U,1)_" "_SCDATE)
.D DIAG^SCDXUTL1(SCE,"SCDXDX")
.S SC40943=0
.S SC40943=$O(SCDXDX(0))
.IF $$PRIMPDX^SCDXUTL1(SCE)>0 D Q
..D MES^XPDUTL(" ..Encounter has already been changed to have a primary dx")
.IF 'SC40943 D Q
..D MES^XPDUTL(" ..No diagnosis for this encounter")
.IF $O(SCDXDX(SC40943)) D Q
..D MES^XPDUTL(" ..Multiple diagnoses - can't know which is primary dx")
.D MES^XPDUTL(" ..Making DX Primary DX & Resetting Transmission Flag")
.Q:$G(SCTEST) ;put in to allow test sites to first run as diagnostic
.D PDX^PXAPIOE(SC40943,"P") ;update outpatient diagnosis to be primary for enc
.S SC40973=$$FINDXMIT^SCDXFU01(SCE) ;ptr to 409.73
.D XMITFLAG^SCDXFU01(SC40973,0) ;resets transmission flag to yes
D:SCNONE BMES^XPDUTL(" ...No errors of this type found")
Q
;
EXIT ;final cleanup
IF $L($G(XPDNM)) D
.D BMES^XPDUTL("This post-install output is saved in the INSTALL File (#9.7)")
.D MES^XPDUTL("under 'SD*5.3*60'.")
D BMES^XPDUTL("This post-install routine may be re-run by calling EN^SD5360PT.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5360PT 3211 printed Apr 09, 2024@21:56:01 Page 2
SD5360PT ;ALB/REW - SD*5.3*60 Post-installation ; 10-DEC-1996
+1 ;;5.3;Scheduling;**60,132**;SEP 25, 1993
+2 ;
EN ;entry point
+1 ;search TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75) to find
+2 ;rejected encounters of type #510 -'Diagnosis Priority is not 1 or null
+3 ;if there is only one diagnosis associated with the encounter, the
+4 ;diagnosis will be marked as 'primary' in the V POV file
+5 ; (#9000010.07) and the encounter will be re-transmitted
+6 ;
+7 DO INTRO
+8 DO SEARCH
+9 DO EXIT
+10 QUIT
+11 ;
INTRO ;header info for output
+1 DO MES^XPDUTL(">>>Searching TRANSMITTED OUTPATIENT ENCOUNTER ERROR File (#409.75)")
+2 DO MES^XPDUTL(" for error code=510 (Diagnosis Priority is not '1' or null.)")
+3 DO MES^XPDUTL(" All such encounters will be displayed.")
+4 DO BMES^XPDUTL(" If there is exactly one DX for an encounter, it will be marked as primary")
+5 DO MES^XPDUTL(" and the encounter marked for nightly transmission to Austin (NPCDB).")
+6 DO MES^XPDUTL("")
+7 QUIT
SEARCH ;look for TRANSMITTED OUTPATIENT ENCOUNTER ENTRIES with error code 510
+1 ; SC40975 = ien of TRANSMITTED OUTPATIENT ENCOUNTER ERROR (#409.75)
+2 ; SC40943 = ien of OUTPATIENT DIAGNOSIS (#409.43)
+3 ; SCNODE = zero node of #409.75
+4 ; SCENODE = zero node of #409.68
+5 ; SCPTR = ptr value for error code for value of '510'
+6 NEW SCE,SCNONE,SC40975,SCNODE,SCPTR,SC40973
+7 SET SCNONE=1
+8 SET SCPTR=$ORDER(^SD(409.76,"B","510",0))
+9 IF 'SCPTR
Begin DoDot:1
+10 DO BMES^XPDUTL(">>> Missing Cross-Reference for code 510 in file 409.76. Aborting")
End DoDot:1
QUIT
+11 SET SC40975=0
+12 FOR
SET SC40975=$ORDER(^SD(409.75,SC40975))
if 'SC40975
QUIT
SET SCNODE=$GET(^(SC40975,0))
Begin DoDot:1
+13 NEW SCDXDX,SC40943,SCENODE,SCDATE,Y
+14 ;must be #510 error
if $PIECE(SCNODE,U,2)'=SCPTR
QUIT
+15 ;null or 409.68 ptr
SET SCE=$PIECE($GET(^SD(409.73,+$PIECE(SCNODE,U,1),0)),U,2)
+16 ;quit if a deleted encounter
+17 if 'SCE
QUIT
+18 SET SCENODE=$GET(^SCE(SCE,0))
+19 IF ('$PIECE(SCENODE,U,1))!('$PIECE(SCENODE,U,2))
Begin DoDot:2
+20 DO BMES^XPDUTL(" File #409.68 ien: "_SCE_" Corrupt/Missing")
+21 DO MES^XPDUTL(" File #409.68 zero node: "_SCENODE)
End DoDot:2
QUIT
+22 SET Y=+SCENODE
DO DD^%DT
SET SCDATE=Y
+23 SET SCNONE=0
+24 DO MES^XPDUTL(" File #409.68 ien: "_SCE_" "_$PIECE(^DPT($PIECE(SCENODE,U,2),0),U,1)_" "_SCDATE)
+25 DO DIAG^SCDXUTL1(SCE,"SCDXDX")
+26 SET SC40943=0
+27 SET SC40943=$ORDER(SCDXDX(0))
+28 IF $$PRIMPDX^SCDXUTL1(SCE)>0
Begin DoDot:2
+29 DO MES^XPDUTL(" ..Encounter has already been changed to have a primary dx")
End DoDot:2
QUIT
+30 IF 'SC40943
Begin DoDot:2
+31 DO MES^XPDUTL(" ..No diagnosis for this encounter")
End DoDot:2
QUIT
+32 IF $ORDER(SCDXDX(SC40943))
Begin DoDot:2
+33 DO MES^XPDUTL(" ..Multiple diagnoses - can't know which is primary dx")
End DoDot:2
QUIT
+34 DO MES^XPDUTL(" ..Making DX Primary DX & Resetting Transmission Flag")
+35 ;put in to allow test sites to first run as diagnostic
if $GET(SCTEST)
QUIT
+36 ;update outpatient diagnosis to be primary for enc
DO PDX^PXAPIOE(SC40943,"P")
+37 ;ptr to 409.73
SET SC40973=$$FINDXMIT^SCDXFU01(SCE)
+38 ;resets transmission flag to yes
DO XMITFLAG^SCDXFU01(SC40973,0)
End DoDot:1
+39 if SCNONE
DO BMES^XPDUTL(" ...No errors of this type found")
+40 QUIT
+41 ;
EXIT ;final cleanup
+1 IF $LENGTH($GET(XPDNM))
Begin DoDot:1
+2 DO BMES^XPDUTL("This post-install output is saved in the INSTALL File (#9.7)")
+3 DO MES^XPDUTL("under 'SD*5.3*60'.")
End DoDot:1
+4 DO BMES^XPDUTL("This post-install routine may be re-run by calling EN^SD5360PT.")
+5 QUIT
