- TIUP328 ;SPFO/AJB - Prescription Drug Monitoring Program ;May 26, 2020@08:16:11
- ;;1.0;TEXT INTEGRATION UTILITIES;**328**;Jun 20, 1997;Build 35
- ;
- ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
- ; $$GET1^DIQ ICR#2056 $$NOW^XLFDT ICR#10103
- ; $$UP^XLFSTR ICR#10104 MES^XPDUTL ICR#10141
- Q
- POST ;
- N CL,DC,DOC,EST,SCR,TIUFPRIV S TIUFPRIV=1
- S SCR="I $P(^(0),U,4)=""CL""" ; screen for the class
- S EST=$$LU(8926.1,"MEDICATION MGT NOTE")
- I '+EST D Q
- . D MES^XPDUTL(""),MES^XPDUTL("Installation Error: Enterprise Standard Title not found"),MES^XPDUTL("")
- S CL=$$LU(8925.1,"PROGRESS NOTES","X",SCR)
- I '+CL D Q
- . D MES^XPDUTL(""),MES^XPDUTL("Installation Error: PROGRESS NOTES Class not found"),MES^XPDUTL("")
- S DC=$$CRDD^TIUCRDD("PDMP TITLES","DC",11,CL) I '+DC D
- . D MES^XPDUTL($P(DC,U,2)),MES^XPDUTL("")
- S DOC=$$CRDD^TIUCRDD("STATE PRESCRIPTION DRUG MONITORING PROGRAM","DOC",11,DC,$G(EST)) I '+DOC D
- . D MES^XPDUTL($P(DOC,U,2)),MES^XPDUTL("")
- Q
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
- Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP328 1131 printed Feb 19, 2025@00:09:30 Page 2
- TIUP328 ;SPFO/AJB - Prescription Drug Monitoring Program ;May 26, 2020@08:16:11
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**328**;Jun 20, 1997;Build 35
- +2 ;
- +3 ; $$FIND1^DIC ICR#2051 UPDATE^DIE ICR#2053
- +4 ; $$GET1^DIQ ICR#2056 $$NOW^XLFDT ICR#10103
- +5 ; $$UP^XLFSTR ICR#10104 MES^XPDUTL ICR#10141
- +6 QUIT
- POST ;
- +1 NEW CL,DC,DOC,EST,SCR,TIUFPRIV
- SET TIUFPRIV=1
- +2 ; screen for the class
- SET SCR="I $P(^(0),U,4)=""CL"""
- +3 SET EST=$$LU(8926.1,"MEDICATION MGT NOTE")
- +4 IF '+EST
- Begin DoDot:1
- +5 DO MES^XPDUTL("")
- DO MES^XPDUTL("Installation Error: Enterprise Standard Title not found")
- DO MES^XPDUTL("")
- End DoDot:1
- QUIT
- +6 SET CL=$$LU(8925.1,"PROGRESS NOTES","X",SCR)
- +7 IF '+CL
- Begin DoDot:1
- +8 DO MES^XPDUTL("")
- DO MES^XPDUTL("Installation Error: PROGRESS NOTES Class not found")
- DO MES^XPDUTL("")
- End DoDot:1
- QUIT
- +9 SET DC=$$CRDD^TIUCRDD("PDMP TITLES","DC",11,CL)
- IF '+DC
- Begin DoDot:1
- +10 DO MES^XPDUTL($PIECE(DC,U,2))
- DO MES^XPDUTL("")
- End DoDot:1
- +11 SET DOC=$$CRDD^TIUCRDD("STATE PRESCRIPTION DRUG MONITORING PROGRAM","DOC",11,DC,$GET(EST))
- IF '+DOC
- Begin DoDot:1
- +12 DO MES^XPDUTL($PIECE(DOC,U,2))
- DO MES^XPDUTL("")
- End DoDot:1
- +13 QUIT
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
- +1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"ERR")