Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECX357PT

ECX357PT.m

Go to the documentation of this file. 
  1. ECX357PT ;ALB/JAM - Restricting Stop Code Post-Init Rtn; 0707/03
  1.  ;;3.0;DSS EXTRACTS;**57**;Dec 22,1997
  1.  ;
  1. POST ; entry point
  1.  ;* Check #728.44 for appropriate Stop Code type
  1.  N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTREQ,ZTSAVE
  1.  D MES^XPDUTL(" ")
  1.  D BMES^XPDUTL("This post install process does the following:-")
  1.  D BMES^XPDUTL("  1. Checks clinics in file #728.44 for invalid Stop Codes and produces")
  1.  D MES^XPDUTL("     a MailMan message.")
  1.  D MES^XPDUTL(" ")
  1.  ;check file #44 and #728.44 for non-conforming restriction type
  1.  S ZTRTN="PROCESS^ECX357PT"
  1.  S ZTDESC="DSS Identifier Non-conforming Clinics Report"
  1.  S ZTIO="",ZTDTH=$H,ZTREQ="@" D ^%ZTLOAD
  1.  D MES^XPDUTL(" ")
  1.  D BMES^XPDUTL("completed...")
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. PROCESS ;background entry point
  1.  ; Locate invalid Stop Code in file #728.44 and put in a mail message
  1.  N ECX,IEN,BLN,COUNT,TXTVAR,I,LNS,CNT,STR,ECXJ,PSC,SSC,DPC,DSC,CNTX,NAM
  1.  N SCN,PSCN,SSCN,DPCN,DSCN,IDT,HTYP
  1.  S COUNT=0,$P(BLN," ",60)="",$P(LNS,"-",80)=""
  1.  S ECXJ=$J K ^TMP($J,"ECX353PT")
  1.  F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT"  D LINE(TXTVAR)
  1.  D CK72844
  1.  D MAIL
  1.  K ^TMP(ECXJ,"ECX353PT"),TEXT,TYP
  1.  Q
  1.  ;
  1. CK72844 ;Check file 728.44 for invalid stop codes.
  1.  S CNTX=0
  1.  D HDR1
  1.  ;search file #728.44 for invalid entries
  1.  S IEN=0 F  S IEN=$O(^ECX(728.44,IEN)) Q:'IEN  K STR D
  1.  .S ECX=$G(^ECX(728.44,IEN,0)),PSC=$P(ECX,U,2),SSC=$P(ECX,U,3)
  1.  .S DPC=$P(ECX,U,4),DSC=$P(ECX,U,5),NAM=$$GET1^DIQ(44,$P(ECX,U),.01)
  1.  .S IDT=$P(ECX,U,10),CNT=1,HTYP=$$GET1^DIQ(44,$P(ECX,U),2,"I")
  1.  .I IDT'="" S NAM="*"_NAM
  1.  .S (PSCN,SSCN,DPCN,DSCN)="" D
  1.  ..I PSC="" S STR(CNT)="Missing primary code",CNT=CNT+1 Q
  1.  ..S PSCN=$$SCIEN(PSC)
  1.  ..I PSCN="" S STR(CNT)=PSC_" Invalid Code",CNT=CNT+1 Q
  1.  ..D SCCHK(PSCN,"P")
  1.  .I SSC'="" S SSCN=$$SCIEN(SSC) D 
  1.  ..I SSCN="" D  Q
  1.  ...Q:PSC=SSC  S STR(CNT)=SSC_" Invalid Code",CNT=CNT+1
  1.  ..D SCCHK(SSCN,"S")
  1.  .D
  1.  ..I DPC="" S STR(CNT)="No DSS primary code",CNT=CNT+1 Q
  1.  ..S DPCN=$$SCIEN(DPC) Q:DPC=PSC
  1.  ..I DPCN="" D  Q
  1.  ...S STR(CNT)=DPC_" Invalid Code",CNT=CNT+1
  1.  ..D SCCHK(DPCN,"P")
  1.  .I DSC'="",DSC'=SSC S DSCN=$$SCIEN(DSC) D
  1.  ..I DSCN="" D  Q
  1.  ...Q:DSC=DPC  Q:DSC=SSC  Q:DSC=DPC
  1.  ...S STR(CNT)=DSC_" Invalid Code",CNT=CNT+1
  1.  ..D SCCHK(DSCN,"S")
  1.  .I $O(STR(0))'="" D
  1.  ..I HTYP'="C" K STR S STR(1)="Not a Clinic"
  1.  ..D LINE(.STR,"S") S CNTX=CNTX+1
  1.  D LINE(" ")
  1.  S STR=$E(BLN,1,25)_$S(CNTX:CNTX,1:"NO")_" PROBLEM CLINICS FOUND."
  1.  D LINE(STR)
  1.  Q
  1.  ;
  1. SCNUM(SCIEN) ;Get stop code Number
  1.  I SCIEN="" Q ""
  1.  S SCN=$P($G(^DIC(40.7,SCIEN,0)),U,2)
  1.  Q SCN
  1.  ;
  1. SCIEN(SCN) ;Get stop code IEN
  1.  I SCN="" Q ""
  1.  S SCIEN=$O(^DIC(40.7,"C",SCN,0))
  1.  Q SCIEN
  1.  ;
  1. SCCHK(SCIEN,TYP) ;check stop code against file 40.7
  1.  N SCN,RTY,CTY
  1.  S CTY=$S(TYP="P":"^P^E^",1:"^S^E^")
  1.  S SCN=$G(^DIC(40.7,SCIEN,0)),RTY=$P(SCN,U,6),SCN=$P(SCN,U,2)
  1.  I SCN="" D  Q
  1.  .I TYP="S" Q:SSC=PSC  Q:DSC=DPC
  1.  .S STR(CNT)=SCIEN_" Invalid pointer."
  1.  .D CNTR
  1.  I RTY="" S STR(CNT)=SCN_" No restriction type" D CNTR Q
  1.  I CTY'[("^"_RTY_"^") D
  1.  .S STR(CNT)=SCN_" cannot be "_$S(TYP="P":"prim",1:"second")_"ary"
  1. CNTR ;counter
  1.  S CNT=CNT+1
  1.  Q
  1.  ;
  1. HDR1 ;header for data from file #728.44
  1.  D LINE(" ")
  1.  D LINE(" ")
  1.  S STR="CLINICS AND STOP CODES File (#728.44) - (Use 'Enter/Edit DSS "
  1.  S STR=STR_"Stop Codes for"
  1.  D LINE(STR)
  1.  S STR=$E(BLN,1,25)_"Clinics' [ECXSCEDIT] menu option to "
  1.  S STR=STR_"make corrections)"
  1.  D LINE(STR)
  1.  D LINE(" ")
  1.  S STR=$E(BLN,1,39)_$E("DSS"_BLN,1,9)_$E("DSS"_BLN,1,9)
  1.  D LINE(STR)
  1.  S STR=$E(BLN,1,21)_$E("PRIMARY"_BLN,1,9)_$E("2NDARY/"_BLN,1,9)
  1.  S STR=STR_$E("PRIMARY"_BLN,1,9)_$E("2NDARY/"_BLN,1,9)
  1.  D LINE(STR)
  1.  S STR=$E("CLINIC NAME"_BLN,1,21)_$E("STOP"_BLN,1,9)_$E("CREDIT"_BLN,1,9)
  1.  S STR=STR_$E("STOP"_BLN,1,9)_$E("CREDIT"_BLN,1,8)_"REASON FOR NON-"
  1.  D LINE(STR)
  1.  S STR=$E("*currently inactive"_BLN,1,21)_$E("CODE"_BLN,1,9)
  1.  S STR=STR_$E("CODE"_BLN,1,9)_$E("CODE"_BLN,1,9)_$E("CODE"_BLN,1,8)
  1.  S STR=STR_"CONFORMANCE"
  1.  D LINE(STR)
  1.  S STR=$E(LNS,1,80)
  1.  D LINE(STR)
  1.  Q
  1. MSGTXT ; Message intro
  1.  ;; Please forward this message to your local DSS Site Manager/ADPAC.
  1.  ;;
  1.  ;; A review of the Primary and Secondary Stop Codes in the CLINICS AND
  1.  ;; STOP CODES file (#728.44) was completed against the Restriction Type
  1.  ;; field (#5) of the CLINIC STOP file (#40.7) for nonconforming clinics.
  1.  ;;
  1.  ;;    
  1.  ;;QUIT
  1.  ;
  1.  ;
  1. LINE(TEXT,TYP) ; Add line to message global
  1.  N FLN,STR,XI
  1.  ;build 1st line with name, codes, etc.
  1.  I $O(TEXT(0))'="" D  Q
  1.  .S STR=$E(NAM_BLN,1,$S(TYP="P":35,1:21))
  1.  .S STR=STR_$E(PSC_BLN,1,$S(TYP="P":10,1:9))
  1.  .S STR=STR_$E(SSC_BLN,1,$S(TYP="P":12,1:9))
  1.  .I TYP="S" S STR=STR_$E(DPC_BLN,1,9)_$E(DSC_BLN,1,8)
  1.  .;set line in ^tmp global
  1.  .S XI=0 F  S XI=$O(TEXT(XI)) Q:'XI  D
  1.  ..S TEXT(XI)=STR_TEXT(XI)
  1.  ..S COUNT=COUNT+1,^TMP(ECXJ,"ECX353PT",COUNT)=TEXT(XI)
  1.  S COUNT=COUNT+1,^TMP(ECXJ,"ECX353PT",COUNT)=TEXT
  1.  Q
  1.  ;
  1. MAIL ; Send message
  1.  N XMDUZ,XMY,XMTEXT,XMSUB
  1.  S XMY(DUZ)="",XMDUZ=.5
  1.  S XMSUB="DSS Identifier Non-Conforming Clinics"
  1.  S XMTEXT="^TMP(ECXJ,""ECX353PT"","
  1.  D ^XMD
  1.  Q