BQIULAY1 ;GDIT/HCS/ALA-Layout continued ; 07 Jul 2017 10:53 AM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
DEF(TYPE,OWNR) ;EP - Add new default template
NEW CRN,CARE,TEMPL,DOR,SOR,SDIR,LYIEN,LIST,STVW,STVCD,IENS
S CRN=$O(^BQI(90506.5,"C",TYPE,"")) I CRN="" Q
S CARE=$P(^BQI(90506.5,CRN,0),U,1),TEMPL=$P(^BQI(90506.5,CRN,0),U,9)
I TEMPL="" S TEMPL=CARE_" Default"
I TYPE="Q" D
. S DOR=$$DFNC^BQICEVW()_$C(29)_$$CDEF^BQICEVW(),SOR=$$SFNC^BQICEVW(CRN,TYPE),SDIR="A"_$C(29)_"D"_$C(29)_"A"
I TYPE'="Q" D
. S DOR=$$DFNC^BQICMVW()_$C(29)_$$CDEF^BQICMVW(),SOR=$$SFNC^BQICMVW(),SDIR="A"
;
D NTMP(TEMPL,.LYIEN)
;
NEW DA,IENS
S DA(1)=OWNR,DA=LYIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90505.015,IENS,.01)=TEMPL
S BQIUPD(90505.015,IENS,.02)=TYPE
S BQIUPD(90505.015,IENS,.05)="Y"
S BQIUPD(90505.015,IENS,.04)=$$NOW^XLFDT()
D FILE^DIE("","BQIUPD","ERROR")
;
S SOR=$G(SOR,""),SDIR=$G(SDIR,"")
S:SOR="" SOR="PN" S:SDIR="" SDIR="A"
;
S DOR=$G(DOR,"")
I DOR="" D
. S LIST="",BN=""
. F S BN=$O(DOR(BN)) Q:BN="" S LIST=LIST_DOR(BN)
. K DOR
. S DOR=LIST
. K LIST
;
F DI=1:1:$L(DOR,$C(29)) S STVCD=$P(DOR,$C(29),DI) Q:STVCD="" D
. S STVW=STVCD
. NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS,Y
. S DA(2)=OWNR,DA(1)=LYIEN
. S DIC="^BQICARE("_DA(2)_",15,"_DA(1)_",1,",DIE=DIC
. S DLAYGO=90505.151,DIC(0)="L",DIC("P")=DLAYGO
. S X=STVW
. I '$D(^BQICARE(DA(2),15,DA(1),1,0)) S ^BQICARE(DA(2),15,DA(1),1,0)="^90505.151^^"
. S DA=$O(^BQICARE(DA(2),15,DA(1),1,"B",X,""))
. I DA="" D
.. K DO,DD D FILE^DICN
.. S DA=+Y
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90505.151,IENS,.02)=DI
. D FILE^DIE("","BQIUPD","ERROR")
. K BQIUPD
;
F SI=1:1:$L(SOR,$C(29)) S STVCD=$P(SOR,$C(29),SI) Q:STVCD="" D
. S SRDR=$P(SDIR,$C(29),SI) S:SRDR="" SRDR="A"
. S STVW=STVCD
. NEW DA,IENS
. S DA(2)=OWNR,DA(1)=LYIEN,DA=$O(^BQICARE(OWNR,15,LYIEN,1,"B",STVW,""))
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90505.151,IENS,.03)=SI
. S BQIUPD(90505.151,IENS,.04)=SRDR
. D FILE^DIE("","BQIUPD","ERROR")
. K BQIUPD
Q
;
NTMP(TEMPL,LYIEN) ;EP
S LYIEN=$O(^BQICARE(DZZ,15,"B",TEMPL,""))
I LYIEN="" D
. NEW DIC,Y,DLAYGO
. I $G(^BQICARE(DZZ,15,0))="" S ^BQICARE(DZZ,15,0)="^90505.015^^"
. S DIC(0)="L",DA(1)=DZZ,DLAYGO="90505.015",DIC="^BQICARE("_DA(1)_",15,",X=TEMPL
. K DD,DO D FILE^DICN
. S LYIEN=+Y
Q
BQIULAY1 ;GDIT/HCS/ALA-Layout continued ; 07 Jul 2017 10:53 AM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
DEF(TYPE,OWNR) ;EP - Add new default template
+1 NEW CRN,CARE,TEMPL,DOR,SOR,SDIR,LYIEN,LIST,STVW,STVCD,IENS
+2 SET CRN=$ORDER(^BQI(90506.5,"C",TYPE,""))
IF CRN=""
QUIT
+3 SET CARE=$PIECE(^BQI(90506.5,CRN,0),U,1)
SET TEMPL=$PIECE(^BQI(90506.5,CRN,0),U,9)
+4 IF TEMPL=""
SET TEMPL=CARE_" Default"
+5 IF TYPE="Q"
Begin DoDot:1
+6 SET DOR=$$DFNC^BQICEVW()_$CHAR(29)_$$CDEF^BQICEVW()
SET SOR=$$SFNC^BQICEVW(CRN,TYPE)
SET SDIR="A"_$CHAR(29)_"D"_$CHAR(29)_"A"
End DoDot:1
+7 IF TYPE'="Q"
Begin DoDot:1
+8 SET DOR=$$DFNC^BQICMVW()_$CHAR(29)_$$CDEF^BQICMVW()
SET SOR=$$SFNC^BQICMVW()
SET SDIR="A"
End DoDot:1
+9 ;
+10 DO NTMP(TEMPL,.LYIEN)
+11 ;
+12 NEW DA,IENS
+13 SET DA(1)=OWNR
SET DA=LYIEN
SET IENS=$$IENS^DILF(.DA)
+14 SET BQIUPD(90505.015,IENS,.01)=TEMPL
+15 SET BQIUPD(90505.015,IENS,.02)=TYPE
+16 SET BQIUPD(90505.015,IENS,.05)="Y"
+17 SET BQIUPD(90505.015,IENS,.04)=$$NOW^XLFDT()
+18 DO FILE^DIE("","BQIUPD","ERROR")
+19 ;
+20 SET SOR=$GET(SOR,"")
SET SDIR=$GET(SDIR,"")
+21 IF SOR=""
SET SOR="PN"
IF SDIR=""
SET SDIR="A"
+22 ;
+23 SET DOR=$GET(DOR,"")
+24 IF DOR=""
Begin DoDot:1
+25 SET LIST=""
SET BN=""
+26 FOR
SET BN=$ORDER(DOR(BN))
IF BN=""
QUIT
SET LIST=LIST_DOR(BN)
+27 KILL DOR
+28 SET DOR=LIST
+29 KILL LIST
End DoDot:1
+30 ;
+31 FOR DI=1:1:$LENGTH(DOR,$CHAR(29))
SET STVCD=$PIECE(DOR,$CHAR(29),DI)
IF STVCD=""
QUIT
Begin DoDot:1
+32 SET STVW=STVCD
+33 NEW DA,X,DINUM,DIC,DIE,DLAYGO,IENS,Y
+34 SET DA(2)=OWNR
SET DA(1)=LYIEN
+35 SET DIC="^BQICARE("_DA(2)_",15,"_DA(1)_",1,"
SET DIE=DIC
+36 SET DLAYGO=90505.151
SET DIC(0)="L"
SET DIC("P")=DLAYGO
+37 SET X=STVW
+38 IF '$DATA(^BQICARE(DA(2),15,DA(1),1,0))
SET ^BQICARE(DA(2),15,DA(1),1,0)="^90505.151^^"
+39 SET DA=$ORDER(^BQICARE(DA(2),15,DA(1),1,"B",X,""))
+40 IF DA=""
Begin DoDot:2
+41 KILL DO,DD
DO FILE^DICN
+42 SET DA=+Y
End DoDot:2
+43 SET IENS=$$IENS^DILF(.DA)
+44 SET BQIUPD(90505.151,IENS,.02)=DI
+45 DO FILE^DIE("","BQIUPD","ERROR")
+46 KILL BQIUPD
End DoDot:1
+47 ;
+48 FOR SI=1:1:$LENGTH(SOR,$CHAR(29))
SET STVCD=$PIECE(SOR,$CHAR(29),SI)
IF STVCD=""
QUIT
Begin DoDot:1
+49 SET SRDR=$PIECE(SDIR,$CHAR(29),SI)
IF SRDR=""
SET SRDR="A"
+50 SET STVW=STVCD
+51 NEW DA,IENS
+52 SET DA(2)=OWNR
SET DA(1)=LYIEN
SET DA=$ORDER(^BQICARE(OWNR,15,LYIEN,1,"B",STVW,""))
+53 SET IENS=$$IENS^DILF(.DA)
+54 SET BQIUPD(90505.151,IENS,.03)=SI
+55 SET BQIUPD(90505.151,IENS,.04)=SRDR
+56 DO FILE^DIE("","BQIUPD","ERROR")
+57 KILL BQIUPD
End DoDot:1
+58 QUIT
+59 ;
NTMP(TEMPL,LYIEN) ;EP
+1 SET LYIEN=$ORDER(^BQICARE(DZZ,15,"B",TEMPL,""))
+2 IF LYIEN=""
Begin DoDot:1
+3 NEW DIC,Y,DLAYGO
+4 IF $GET(^BQICARE(DZZ,15,0))=""
SET ^BQICARE(DZZ,15,0)="^90505.015^^"
+5 SET DIC(0)="L"
SET DA(1)=DZZ
SET DLAYGO="90505.015"
SET DIC="^BQICARE("_DA(1)_",15,"
SET X=TEMPL
+6 KILL DD,DO
DO FILE^DICN
+7 SET LYIEN=+Y
End DoDot:1
+8 QUIT
