- BEHOAMH ;IHS/MSC/PLS - RPCS FOR BEHAVIORAL HEALTH;28-Oct-2015 04:43;du
- ;;1.1;BEH COMPONENTS;**013004**;Sept 18, 2007;Build 1
- ;==========================================================
- FORMIENS(DATA,IEN) ;EP- Returns IENS for fields .03;.07;.25
- N FN,FLDS,DARY,IENS,FLD
- S DATA="",IENS=IEN_","
- S FN=9002011.65,FLDS=".03;.07;.25"
- D GETS^DIQ(FN,IEN_",",FLDS,"I","DARY")
- F I=1:1:$L(FLDS,";") D
- .S FLD=$P(FLDS,";",I)
- .S DATA=DATA_$S($L(DATA):U,1:"")_FLD_":"_$G(DARY(FN,IENS,FLD,"I"))
- Q
- POST ;Post-init for EHR patch 17 to clean up data in the MHSS SUICIDE FORMS file
- ;has text data stored in pointer fields
- N AIEN,DATA,PRV,COM,DISP,PIEN,FDA,IENS,ERR,PIEN,DIEN
- S (PIEN,CIEN,DIEN)=""
- S AIEN=0 F S AIEN=$O(^AMHPSUIC(AIEN)) Q:'+AIEN D
- .S DATA=$G(^AMHPSUIC(AIEN,0))
- .S PRV=$P(DATA,U,3)
- .Q:PRV=""
- .I '+PRV D
- ..S PIEN=$O(^VA(200,"B",PRV,"")) Q:'+PIEN D
- ...S FDA(9002011.65,AIEN_",",.03)=PIEN
- .S COM=$P(DATA,U,7)
- .Q:COM=""
- .I '+COM D
- ..S CIEN=$O(^AUTTCOM("B",COM,"")) Q:'+CIEN D
- ...S FDA(9002011.65,AIEN_",",.07)=CIEN
- .S DISP=$P(DATA,U,25)
- .Q:DISP=""
- .I '+DISP D
- ..S DIEN=$O(^AMHTSDT("B",DISP,"")) Q:'+DIEN D
- ...S FDA(9002011.65,AIEN_",",.25)=DIEN
- .I $D(FDA) D
- ..D UPDATE^DIE("","FDA","IENS","ERR")
- ..K FDA,IENS,ERR
- Q
- BEHOAMH ;IHS/MSC/PLS - RPCS FOR BEHAVIORAL HEALTH;28-Oct-2015 04:43;du
- +1 ;;1.1;BEH COMPONENTS;**013004**;Sept 18, 2007;Build 1
- +2 ;==========================================================
- FORMIENS(DATA,IEN) ;EP- Returns IENS for fields .03;.07;.25
- +1 NEW FN,FLDS,DARY,IENS,FLD
- +2 SET DATA=""
- SET IENS=IEN_","
- +3 SET FN=9002011.65
- SET FLDS=".03;.07;.25"
- +4 DO GETS^DIQ(FN,IEN_",",FLDS,"I","DARY")
- +5 FOR I=1:1:$LENGTH(FLDS,";")
- Begin DoDot:1
- +6 SET FLD=$PIECE(FLDS,";",I)
- +7 SET DATA=DATA_$SELECT($LENGTH(DATA):U,1:"")_FLD_":"_$GET(DARY(FN,IENS,FLD,"I"))
- End DoDot:1
- +8 QUIT
- POST ;Post-init for EHR patch 17 to clean up data in the MHSS SUICIDE FORMS file
- +1 ;has text data stored in pointer fields
- +2 NEW AIEN,DATA,PRV,COM,DISP,PIEN,FDA,IENS,ERR,PIEN,DIEN
- +3 SET (PIEN,CIEN,DIEN)=""
- +4 SET AIEN=0
- FOR
- SET AIEN=$ORDER(^AMHPSUIC(AIEN))
- IF '+AIEN
- QUIT
- Begin DoDot:1
- +5 SET DATA=$GET(^AMHPSUIC(AIEN,0))
- +6 SET PRV=$PIECE(DATA,U,3)
- +7 IF PRV=""
- QUIT
- +8 IF '+PRV
- Begin DoDot:2
- +9 SET PIEN=$ORDER(^VA(200,"B",PRV,""))
- IF '+PIEN
- QUIT
- Begin DoDot:3
- +10 SET FDA(9002011.65,AIEN_",",.03)=PIEN
- End DoDot:3
- End DoDot:2
- +11 SET COM=$PIECE(DATA,U,7)
- +12 IF COM=""
- QUIT
- +13 IF '+COM
- Begin DoDot:2
- +14 SET CIEN=$ORDER(^AUTTCOM("B",COM,""))
- IF '+CIEN
- QUIT
- Begin DoDot:3
- +15 SET FDA(9002011.65,AIEN_",",.07)=CIEN
- End DoDot:3
- End DoDot:2
- +16 SET DISP=$PIECE(DATA,U,25)
- +17 IF DISP=""
- QUIT
- +18 IF '+DISP
- Begin DoDot:2
- +19 SET DIEN=$ORDER(^AMHTSDT("B",DISP,""))
- IF '+DIEN
- QUIT
- Begin DoDot:3
- +20 SET FDA(9002011.65,AIEN_",",.25)=DIEN
- End DoDot:3
- End DoDot:2
- +21 IF $DATA(FDA)
- Begin DoDot:2
- +22 DO UPDATE^DIE("","FDA","IENS","ERR")
- +23 KILL FDA,IENS,ERR
- End DoDot:2
- End DoDot:1
- +24 QUIT
