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

GMRCYP15.m

Go to the documentation of this file.
  1. GMRCYP15 ;SLC/JFR-- CONVERT PROCEDURES FROM 101 TO 123.3; 3/08/01 22:00
  1. ;;3.0;CONSULT/REQUEST TRACKING;**15**;DEC 27, 1997
  1. ;
  1. ; This routine invokes IA #3169,#3170
  1. ;
  1. EN ;called from post-install of GMRC*3*15
  1. N GMRCPROG,XPDIDTOT
  1. S GMRCPROG=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1)
  1. I GMRCPROG=3 D BMES^XPDUTL("Procedure conversion complete") Q
  1. I GMRCPROG<2 D
  1. . D CVTOIS
  1. . D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,2)
  1. D CVT123
  1. D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,3)
  1. D MAIL
  1. Q
  1. ;
  1. CVTOIS ;loop through ORD ITEMS in S.PROC x-ref
  1. N ITMNM,ORDITM,PROC,PROTID,GMRCID
  1. D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,1)
  1. D BMES^XPDUTL("Converting Orderable Items")
  1. S ITMNM="",^XTMP("GMRCCVPR",0)=$$FMADD^XLFDT($$NOW^XLFDT,14)
  1. S $P(^XTMP("GMRCCVPR",0),U,2)=$$NOW^XLFDT
  1. S $P(^XTMP("GMRCCVPR",0),U,3)="Conversion of GMRC Procedure ord. items"
  1. F S ITMNM=$O(^ORD(101.43,"S.PROC",ITMNM)) Q:ITMNM="" D
  1. . S ORDITM=0
  1. . F S ORDITM=$O(^ORD(101.43,"S.PROC",ITMNM,ORDITM)) Q:'ORDITM D
  1. .. I '$$OKTOGO(ITMNM,ORDITM) Q
  1. .. S PROC=$$CNVT(ORDITM) I '+PROC Q
  1. .. S PROTID=$P(^ORD(101.43,ORDITM,0),U,2)
  1. .. S GMRCID=$$ID^ORDD43(PROTID,PROC_";99PRC")
  1. .. S ^XTMP("GMRCCVPR",ORDITM)=PROC_U_$S($G(GMRCID):$G(PROTID),1:"ERROR")
  1. .. Q
  1. . Q
  1. Q
  1. OKTOGO(NAME,NUM) ;OK to move from 101.43 to 123.3?
  1. I $D(^XTMP("GMRCCVPR",NUM)) Q 0 ;already converted
  1. I +$G(^ORD(101.43,"S.PROC",NAME,NUM)),$P(^ORD(101.43,NUM,0),U)'=NAME Q 0 ;synonym only
  1. I '+$P(^ORD(101.43,NUM,0),U,2) Q 0 ;no protocol
  1. I $P(^ORD(101.43,NUM,0),U,2)[";99PRC" Q 0 ;new ID already
  1. Q 1
  1. CNVT(IEN) ;move it from 101.43 to 123.3
  1. N DIC,DIE,DR,DA,X,Y,DTOUT,DUOUT,DLAYGO,ORD0,GMRCPROC,NEW
  1. S DIC="^GMR(123.3,",DIC(0)="XL",DLAYGO=123.3
  1. S ORD0=^ORD(101.43,IEN,0)
  1. S X=$$UP^XLFSTR($P(ORD0,U))
  1. D ^DIC I Y'>0 Q 0
  1. S DIE=DIC,DA=+Y,GMRCPROC=+Y,NEW=$P(Y,U,3)
  1. I +NEW S DR=".06_////"_+$P(ORD0,U,2)
  1. I +$G(^ORD(101.43,IEN,.1)) S DR=$S($D(DR):DR_";",1:"")_".02///1"
  1. I $D(DR) D ^DIE
  1. D SYN(IEN,GMRCPROC)
  1. D SERVS(GMRCPROC,+$P(ORD0,U,2))
  1. Q +GMRCPROC
  1. SYN(OITM,PROC) ;get any synonyms from 101.43 and update 123.3
  1. N DR,DIC,X,Y,DTOUT,SYN,DA
  1. S SYN=0
  1. F S SYN=$O(^ORD(101.43,OITM,2,SYN)) Q:'SYN I $L($G(^(SYN,0))) D
  1. . S DA(1)=PROC,DIC="^GMR(123.3,"_DA(1)_",1,"
  1. . S DIC(0)="XL",DIC("P")=$P(^DD(123.3,1,0),U,2)
  1. . S X=$P(^ORD(101.43,OITM,2,SYN,0),U)
  1. . D ^DIC
  1. Q
  1. SERVS(PROC,PROT) ;get related servisces from 123.5 and move to 123.3
  1. N DR,DIC,X,Y,DTOUT,SERV,DA
  1. S SERV=0
  1. F S SERV=$O(^GMR(123.5,"APR",PROT,SERV)) Q:'SERV D
  1. . S DA(1)=PROC,DIC="^GMR(123.3,"_DA(1)_",2,",X=$P(^GMR(123.5,SERV,0),U)
  1. . S DIC(0)="XL",DIC("P")=$P(^DD(123.3,2,0),U,2)
  1. . D ^DIC
  1. Q
  1. CVTPRO(PROT) ;move protocol entry to 123.3
  1. N DIC,DIE,DR,DA,X,Y,DLAYGO,NAME,PROC
  1. I '$D(^ORD(101,PROT,0)) Q 1 ;no protocol there
  1. S NAME=$P(^ORD(101,PROT,0),U,2) I '$L(NAME) Q 1 ;no name
  1. I $G(^ORD(101,PROT,20))'["GMRCEN=""R""" Q "" ;consult type
  1. S DIC="^GMR(123.3,",DIC(0)="LX",X=$$UP^XLFSTR(NAME)
  1. D ^DIC I +Y<0 Q 1
  1. I '$P(Y,U,3) Q +Y
  1. S (PROC,DA)=+Y
  1. S DIE=DIC,DR=".02///1;.06///^S X=PROT" D ^DIE
  1. Q +PROC
  1. ;
  1. ;
  1. CVT123 ; loop through file 123 and convert field #4 and #13
  1. N IEN,PROC,GMRCCSLT,GMRCPRC,GMR0
  1. D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,2)
  1. D BMES^XPDUTL("Converting REQUEST/CONSULTATION data")
  1. S XPDIDTOT=$P(^GMR(123,0),U,4) I XPDIDTOT<100 K XPDIDTOT
  1. S GMRCCSLT=$$FIND1^DIC(101,,"QX","GMRCOR CONSULT")
  1. S GMRCPRC=$$FIND1^DIC(101,,"QX","GMRCOR REQUEST")
  1. S IEN=0 F S IEN=$O(^GMR(123,IEN)) Q:'IEN D
  1. . I $D(XPDIDTOT) I '(IEN#(XPDIDTOT\20)) D UPDATE^XPDID(IEN)
  1. . Q:'$D(^GMR(123,IEN,0))
  1. . S GMR0=^GMR(123,IEN,0)
  1. . I $P(GMR0,U,17)'="C"&($P(GMR0,U,17)'="P") D ;not converted yet
  1. .. I $P(GMR0,U,8)["ORD(101" D
  1. ... N NWPROC
  1. ... S NWPROC=$$CVT4(+$P(^GMR(123,IEN,0),U,8))
  1. ... I +NWPROC=1 S ^XTMP("GMRCCVPR","UNK",IEN)=$P(GMR0,U,8)
  1. ... S $P(^GMR(123,IEN,0),U,8)=NWPROC
  1. .. S $P(^GMR(123,IEN,0),U,17)=$S(+$P(^GMR(123,IEN,0),U,8):"P",1:"C")
  1. .. Q
  1. . Q
  1. Q
  1. CVT4(PCL) ;convert field 4 from 101 to 123.3
  1. ; PCL = pointer to file 101
  1. N PROC
  1. S PROC=$O(^GMR(123.3,"AP",PCL,0))
  1. I 'PROC S PROC=$$CVTPRO(PCL)
  1. Q $S(+PROC:PROC_";GMR(123.3,",1:"")
  1. ;
  1. ;
  1. MAIL ; check conversion and send mail to installer
  1. D CK10143
  1. D CHK123
  1. I '$D(^TMP("GMRCP15",$J)) D
  1. . S ^TMP("GMRCP15",$J,1,0)="No problems found with the conversion."
  1. S ^TMP("GMRCP15",$J,0)=""
  1. N GMRCSB,GMRCTO,GMRCTXT,GMRCMSG
  1. S GMRCSB="GMRC*3*15 Post-install conversion report"
  1. S GMRCTXT=$NA(^TMP("GMRCP15",$J))
  1. S GMRCTO(DUZ)=""
  1. D SENDMSG^XMXAPI(DUZ,GMRCSB,GMRCTXT,.GMRCTO,,.GMRCMSG)
  1. I $G(GMRCMSG) D
  1. . D BMES^XPDUTL("Mail message "_GMRCMSG_" sent to installer")
  1. . N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,ZTIO,GMRCDUZ
  1. . S GMRCDUZ=DUZ
  1. . S ZTSAVE("GMRCMSG")="",ZTSAVE("GMRCDUZ")=""
  1. . S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,5),ZTRTN="NWMAL^GMRCYP15"
  1. . S ZTIO="",ZTDESC="New GMRC*3*15 post-install message"
  1. . D ^%ZTLOAD
  1. K ^TMP("GMRCP15",$J)
  1. Q
  1. ;
  1. NWMAL ;make post-install message new
  1. S ZTREQ="@"
  1. I $G(GMRCMSG),$G(GMRCDUZ) D
  1. . D MAKENEW^XMXUTIL(DUZ,1,GMRCMSG,1)
  1. Q
  1. ;
  1. CHK123 ;loop 123 and check field 4 to make sure it's converted
  1. N GMRCIEN,PROC,NEXT
  1. S GMRCIEN=0
  1. I $D(^TMP("GMRCP15",$J)) D
  1. . S ^TMP("GMRCP15",$J,$O(^TMP("GMRCP15",$J," "),-1)+1,0)=""
  1. F S GMRCIEN=$O(^GMR(123,GMRCIEN)) Q:'GMRCIEN D
  1. . I $D(XPDIDTOT) D:'(GMRCIEN#(XPDIDTOT\20)) UPDATE^XPDID(GMRCIEN)
  1. . I '$D(XPDNM) W:'(GMRCIEN#78000) !,"Working",!
  1. . I '$D(XPDNM) W:'(GMRCIEN#1000) "."
  1. . S PROC=$P($G(^GMR(123,GMRCIEN,0)),U,8) I '$L(PROC) Q
  1. . I PROC["ORD(101"!(PROC="1;GMR(123.3,") D
  1. .. S NEXT=$O(^TMP("GMRCP15",$J," "),-1)+1
  1. .. S ^TMP("GMRCP15",$J,NEXT,0)="File 123 ien "_GMRCIEN_" points to "_PROC
  1. . Q
  1. Q
  1. CK10143 ;loop thru S.PROC x-ref in 101.43 and check for complete conv
  1. N OINAME,OINUM,NEXT
  1. D BMES^XPDUTL("Checking converted data")
  1. S OINAME=""
  1. F S OINAME=$O(^ORD(101.43,"S.PROC",OINAME)) Q:OINAME="" D
  1. . S OINUM=$O(^ORD(101.43,"S.PROC",OINAME,0)) Q:'OINUM
  1. . I +$G(^ORD(101.43,"S.PROC",OINAME,OINUM)) Q ;syn only
  1. . I $P($G(^ORD(101.43,OINUM,0)),U,2)'["99PRC" D
  1. .. S NEXT=$O(^TMP("GMRCP15",$J," "),-1)+1
  1. .. S ^TMP("GMRCP15",$J,NEXT,0)="File 101.43 ien "_OINUM_" has a bad ID"
  1. . Q
  1. Q