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